@@ -1,5 +1,69 @@
This file documents the revision history for Perl extension Mojolicious.
+0.999950 2010-11-30 00:00:00
+ - Added EXPERIMENTAL Hypnotoad web server.
+ - Added EXPERIMENTAL built in exception and not_found templates.
+ - Added put and del functions to Mojolicious::Lite.
+ - Added on_idle and on_tick event handlers to Mojo::IOLoop.
+ - Added "*" query support to the Mojo::IOLoop resolver.
+ - Added ability to pass plain connection ids to Mojo::Client.
+ - Added ability to call Mojo::Base->attr as an instance method.
+ (charsbar)
+ - Improved Mojolicious::Lite ability to recover from syntax errors.
+ - Improved number detection in Mojo::JSON.
+ - Improved Mojo::ByteStream encode/decode. (marcus)
+ - Fixed a bug where an empty Mojo::IOLoop would never block.
+ - Fixed a possible Mojo::IOLoop descriptor leak.
+ - Fixed a small route condition bug.
+ - Fixed a small test glitch on some Linux distributions.
+ - Fixed typos.
+
+0.999941 2010-11-19 00:00:00
+ - Allow Mojolicious::Lite style routes in Mojolicious.
+ - Added base_tag helper to Mojolicious::Plugin::TagHelpers.
+ - Added CNAME and NS record type support to the Mojo::IOLoop
+ resolver.
+ - Improved Mojo::IOLoop responsiveness.
+ - Made Mojo::IOLoop resolver results more useful.
+
+0.999940 2010-11-15 00:00:00
+ - Improved resolver tests.
+ - Fixed IO::Socket::SSL 1.34 compatibility.
+
+0.999939 2010-11-15 00:00:00
+ - Removed IPv6 support until Perl itself gets better support for it.
+ - Added MX and PTR record type support to the Mojo::IOLoop resolver.
+ (und3f)
+ - Fixed a Mojolicious::Static rendering bug.
+ - Fixed a bug that forced connect in Mojo::IOLoop to block.
+ - Fixed a bug that prevented on_finish to be triggered for
+ interrupted connections.
+ - Fixed a TLS accept bug in Mojo::IOLoop.
+ - Fixed a small bug in Mojo::Parameters. (spleenjack)
+ - Fixed javascript and stylesheet helper. (sshaw)
+ - Fixed IPv4 address detection bug in Mojo::URL.
+ - Fixed a Mojo::Client bug where interrupted transactions were still
+ successful.
+ - Fixed a small reloader bug.
+ - Fixed typos.
+
+0.999938 2010-11-09 00:00:00
+ - Moved all commands into the Mojolicious namespace.
+ - Fixed typo.
+ - Removed OS X resource fork files.
+
+0.999937 2010-11-09 00:00:00
+ - Deprecated the MojoX namespace and merged affected modules into the
+ Mojolicious namespace, this will make reference documentation a lot
+ more accessible.
+ - Added important module overview to Mojolicious. (rhaen)
+ - Improved Mojo::Loader to allow Mojolicious recovering from tricky
+ syntax errors in Controllers.
+ - Improved param method in MojoX::Dispatcher::Routes::Controller.
+ - Fixed escaping in Mojo::Parameters to work better in the real
+ world.
+ - Fixed a small inflate command bug.
+
0.999936 2010-11-03 00:00:00
- Improved Mojo::Template performance slightly. (kimoto)
- Fixed a serious WebSocket bug.
@@ -11,14 +11,6 @@ lib/Mojo/Base.pm
lib/Mojo/ByteStream.pm
lib/Mojo/Client.pm
lib/Mojo/Command.pm
-lib/Mojo/Command/Cgi.pm
-lib/Mojo/Command/Daemon.pm
-lib/Mojo/Command/Fastcgi.pm
-lib/Mojo/Command/Get.pm
-lib/Mojo/Command/Psgi.pm
-lib/Mojo/Command/Test.pm
-lib/Mojo/Command/Version.pm
-lib/Mojo/Commands.pm
lib/Mojo/Content.pm
lib/Mojo/Content/MultiPart.pm
lib/Mojo/Content/Single.pm
@@ -45,6 +37,7 @@ lib/Mojo/Server.pm
lib/Mojo/Server/CGI.pm
lib/Mojo/Server/Daemon.pm
lib/Mojo/Server/FastCGI.pm
+lib/Mojo/Server/Hypnotoad.pm
lib/Mojo/Server/PSGI.pm
lib/Mojo/Template.pm
lib/Mojo/Transaction.pm
@@ -54,13 +47,21 @@ lib/Mojo/Upload.pm
lib/Mojo/URL.pm
lib/Mojo/Util.pm
lib/Mojolicious.pm
+lib/Mojolicious/Command/Cgi.pm
+lib/Mojolicious/Command/Daemon.pm
+lib/Mojolicious/Command/Fastcgi.pm
lib/Mojolicious/Command/Generate.pm
lib/Mojolicious/Command/Generate/App.pm
lib/Mojolicious/Command/Generate/Gitignore.pm
+lib/Mojolicious/Command/Generate/Hypnotoad.pm
lib/Mojolicious/Command/Generate/LiteApp.pm
lib/Mojolicious/Command/Generate/Makefile.pm
+lib/Mojolicious/Command/Get.pm
lib/Mojolicious/Command/Inflate.pm
+lib/Mojolicious/Command/Psgi.pm
lib/Mojolicious/Command/Routes.pm
+lib/Mojolicious/Command/Test.pm
+lib/Mojolicious/Command/Version.pm
lib/Mojolicious/Commands.pm
lib/Mojolicious/Controller.pm
lib/Mojolicious/Guides.pod
@@ -85,17 +86,13 @@ lib/Mojolicious/Plugin/PoweredBy.pm
lib/Mojolicious/Plugin/RequestTimer.pm
lib/Mojolicious/Plugin/TagHelpers.pm
lib/Mojolicious/Plugins.pm
-lib/MojoX/Controller.pm
-lib/MojoX/Dispatcher/Routes.pm
-lib/MojoX/Dispatcher/Routes/Controller.pm
-lib/MojoX/Dispatcher/Static.pm
-lib/MojoX/Renderer.pm
-lib/MojoX/Routes.pm
-lib/MojoX/Routes/Match.pm
-lib/MojoX/Routes/Pattern.pm
-lib/MojoX/Session/Cookie.pm
-lib/MojoX/Session/Cookie/Controller.pm
-lib/MojoX/Types.pm
+lib/Mojolicious/Renderer.pm
+lib/Mojolicious/Routes.pm
+lib/Mojolicious/Routes/Match.pm
+lib/Mojolicious/Routes/Pattern.pm
+lib/Mojolicious/Session.pm
+lib/Mojolicious/Static.pm
+lib/Mojolicious/Types.pm
lib/ojo.pm
lib/Test/Mojo.pm
LICENSE
@@ -103,6 +100,7 @@ Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
README.pod
+script/hypnotoad
script/mojo
t/mojo/apache_cgi.t
t/mojo/apache_fastcgi.t
@@ -121,7 +119,10 @@ t/mojo/dom.t
t/mojo/fastcgi.t
t/mojo/headers.t
t/mojo/home.t
+t/mojo/hypnotoad.t
t/mojo/ioloop.t
+t/mojo/ioloop_online.t
+t/mojo/ioloop_tls.t
t/mojo/json.t
t/mojo/lib/LoaderException.pm
t/mojo/lib/LoaderException2.pm
@@ -139,8 +140,10 @@ t/mojo/template.t
t/mojo/url.t
t/mojolicious/app.t
t/mojolicious/charset_lite_app.t
+t/mojolicious/dispatch.t
t/mojolicious/dispatcher_lite_app.t
t/mojolicious/embedded_lite_app.t
+t/mojolicious/exception_lite_app.t
t/mojolicious/external_lite_app.json
t/mojolicious/external_lite_app.pl
t/mojolicious/external_lite_app.t
@@ -162,11 +165,14 @@ t/mojolicious/lib/PluginWithTemplate.pm
t/mojolicious/lib/SingleFileTestApp.pm
t/mojolicious/lite_app.t
t/mojolicious/longpolling_lite_app.t
+t/mojolicious/pattern.t
t/mojolicious/pod_renderer_lite_app.t
t/mojolicious/production_app.t
t/mojolicious/public/hello.txt
t/mojolicious/public/hello2.txt
t/mojolicious/public_dev/hello.txt
+t/mojolicious/renderer.t
+t/mojolicious/routes.t
t/mojolicious/secret.txt
t/mojolicious/templates/23.html.epl
t/mojolicious/templates/encoding.koi8-r.ep
@@ -186,10 +192,6 @@ t/mojolicious/upload_lite_app.t
t/mojolicious/websocket_lite_app.t
t/mojolicious/websocket_proxy_lite_app.t
t/mojolicious/websocket_tls_proxy_lite_app.t
-t/mojox/dispatcher.t
-t/mojox/pattern.t
-t/mojox/renderer.t
-t/mojox/routes.t
t/pod.t
t/pod_coverage.t
META.yml Module meta-data (added by MakeMaker)
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Mojolicious
-version: 0.999936
+version: 0.999950
abstract: The Web In A Box!
author:
- Sebastian Riedel <sri@cpan.org>
@@ -9,6 +9,7 @@ distribution_type: module
configure_requires: {}
build_requires: {}
requires:
+ B: 0
Carp: 0
Cwd: 0
Data::Dumper: 0
@@ -29,6 +30,7 @@ requires:
IO::File: 0
IO::Poll: 0
IO::Socket: 0
+ List::Util: 0
Locale::Maketext: 0
MIME::Base64: 0
MIME::QuotedPrint: 0
@@ -42,8 +42,9 @@ WriteMakefile(
)
),
- EXE_FILES => ['script/mojo'],
+ EXE_FILES => ['script/mojo', 'script/hypnotoad'],
PREREQ_PM => {
+ 'B' => 0,
'Carp' => 0,
'Cwd' => 0,
'Data::Dumper' => 0,
@@ -64,6 +65,7 @@ WriteMakefile(
'IO::File' => 0,
'IO::Poll' => 0,
'IO::Socket' => 0,
+ 'List::Util' => 0,
'Locale::Maketext' => 0,
'MIME::Base64' => 0,
'MIME::QuotedPrint' => 0,
@@ -34,8 +34,8 @@ magic and no requirements besides Perl 5.8.7.
=item *
-Full stack HTTP 1.1 and WebSocket client/server implementation with IPv6,
-TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
+Full stack HTTP 1.1 and WebSocket client/server implementation with TLS,
+Bonjour, IDNA, Comet (long polling), chunking and multipart support.
=item *
@@ -98,9 +98,6 @@ Web development for humans, making hard things possible and everything fun.
The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
<% end %>
-For more user friendly documentation see L<Mojolicious::Guides> and
-L<Mojolicious::Lite>.
-
=head2 Have Some Cake
Loosely coupled building blocks, use what you like and just ignore the rest.
@@ -33,7 +33,7 @@ $loop->listen(
$buffer->{$id} .= $chunk;
# Check if we got start line and headers (no body support)
- if (index $buffer->{$id}, "\x0d\x0a\x0d\x0a") {
+ if (index($buffer->{$id}, "\x0d\x0a\x0d\x0a") >= 0) {
# Clean buffer
delete $buffer->{$id};
@@ -55,7 +55,7 @@ $loop->listen(
print <<'EOF';
Starting server on port 3000.
Try something like "ab -c 30 -n 100000 -k http://127.0.0.1:3000/" for testing.
-On a MacBook Pro 13" this results in about 24k req/s.
+On a MacBook Pro 13" this results in about 25k req/s.
EOF
# Start loop
@@ -76,9 +76,6 @@ sub add_chunk {
return $self;
}
-# Your guilty consciences may make you vote Democratic, but secretly you all
-# yearn for a Republican president to lower taxes, brutalize criminals, and
-# rule you like a king!
sub contains {
my ($self, $bytestream) = @_;
my ($buffer, $window);
@@ -35,6 +35,9 @@ sub attr {
Carp::croak('Default has to be a code reference or constant value')
if ref $default && ref $default ne 'CODE';
+ # Instance
+ $class = ref $class || $class;
+
# Allow symbolic references
no strict 'refs';
@@ -82,6 +85,7 @@ sub attr {
$code .= '};';
# We compile custom attribute code for speed
+ no warnings 'redefine';
*{"${class}::$attr"} = eval $code;
# This should never happen (hopefully)
@@ -11,6 +11,7 @@ use Mojo::Util;
sub import {
my $caller = caller;
no strict 'refs';
+ no warnings 'redefine';
*{"${caller}::b"} = sub {
bless {
bytestream => @_ < 2 ? defined $_[0] ? "$_[0]" : '' : join('', @_)
@@ -66,13 +67,13 @@ sub decamelize {
# Number 3: "It was like that when I got here."
sub decode {
my $self = shift;
- Mojo::Util::decode shift, $self->{bytestream};
+ Mojo::Util::decode shift || 'UTF-8', $self->{bytestream};
return $self;
}
sub encode {
my $self = shift;
- Mojo::Util::encode shift, $self->{bytestream};
+ Mojo::Util::encode shift || 'UTF-8', $self->{bytestream};
return $self;
}
@@ -304,17 +305,19 @@ Decamelize bytestream.
=head2 C<decode>
+ $stream = $stream->decode;
$stream = $stream->decode($encoding);
-Decode bytestream.
+Decode bytestream, defaults to C<UTF-8>.
$stream->decode('UTF-8')->to_string;
=head2 C<encode>
+ $stream = $stream->encode;
$stream = $stream->encode($encoding);
-Encode bytestream.
+Encode bytestream, defaults to C<UTF-8>.
$stream->encode('UTF-8')->to_string;
@@ -188,7 +188,7 @@ sub build_form_tx {
# Filename
$filename = delete $f->{filename} || $name;
encode $encoding, $filename if $encoding;
- url_escape $filename, $Mojo::URL::PARAM;
+ url_escape $filename, $Mojo::URL::UNRESERVED;
# Asset
$part->asset(delete $f->{file});
@@ -213,7 +213,7 @@ sub build_form_tx {
# Content-Disposition
encode $encoding, $name if $encoding;
- url_escape $name, $Mojo::URL::PARAM;
+ url_escape $name, $Mojo::URL::UNRESERVED;
my $disposition = qq/form-data; name="$name"/;
$disposition .= qq/; filename="$filename"/ if $filename;
$h->content_disposition($disposition);
@@ -489,7 +489,7 @@ sub test_server {
Mojo::Server::Daemon->new(ioloop => $self->ioloop, silent => 1);
my $port = $self->{_port} = $self->ioloop->generate_port;
die "Couldn't find a free TCP port for testing.\n" unless $port;
- $server->listen("http://*:$port");
+ $server->listen(["http://*:$port"]);
$server->prepare_ioloop;
}
@@ -580,6 +580,9 @@ sub _connect {
# Info
my ($scheme, $address, $port) = $self->_tx_info($tx);
+ # Weaken
+ weaken $self;
+
# Keep alive connection
$id ||= $self->_cache("$scheme:$address:$port");
if ($id && !ref $id) {
@@ -610,19 +613,13 @@ sub _connect {
# Debug
warn "NEW CONNECTION ($scheme:$address:$port)\n" if DEBUG;
- # Weaken
- weaken $self;
-
# Connect
$id = $loop->connect(
address => $address,
port => $port,
- socket => $id,
+ handle => $id,
tls => $scheme eq 'https' ? 1 : 0,
- on_connect => sub { $self->_connected($_[1]) },
- on_error => sub { $self->_error(@_) },
- on_hup => sub { $self->_hup(@_) },
- on_read => sub { $self->_read(@_) }
+ on_connect => sub { $self->_connected($_[1]) }
);
# Error
@@ -636,6 +633,11 @@ sub _connect {
$self->{_cs}->{$id} = {cb => $cb, tx => $tx};
}
+ # Callbacks
+ $loop->on_error($id => sub { $self->_error(@_) });
+ $loop->on_hup($id => sub { $self->_hup(@_) });
+ $loop->on_read($id => sub { $self->_read(@_) });
+
return $id;
}
@@ -740,7 +742,7 @@ sub _drop {
# Don't keep CONNECTed connections alive
my $method = $tx->req->method || '';
my $code = $tx->res->code || '';
- unless ($method eq 'CONNECT' && $code eq '200') {
+ unless ($method =~ /^connect$/i && $code eq '200') {
# Keep connection alive
$self->_cache(join(':', $self->_tx_info($tx)), $id);
@@ -814,6 +816,10 @@ sub _handle {
# Idle connection
return unless $old;
+ # Interrupted
+ $old->res->error('Interrupted, maybe a timeout?')
+ unless $old->is_done;
+
# Extract cookies
if (my $jar = $self->cookie_jar) { $jar->extract($old) }
@@ -1121,8 +1127,8 @@ Mojo::Client - Async IO HTTP 1.1 And WebSocket Client
my $client = Mojo::Client->new;
# Grab the latest Mojolicious release :)
- my $latest = 'http://mojolicious.org/Mojolicious-latest.tar.gz';
- print $client->get($latest)->res->body;
+ my $latest = 'http://latest.mojolicio.us';
+ print $client->max_redirects(3)->get($latest)->res->body;
# Quick JSON request
my $trends = 'http://search.twitter.com/trends.json';
@@ -1172,10 +1178,10 @@ Mojo::Client - Async IO HTTP 1.1 And WebSocket Client
=head1 DESCRIPTION
L<Mojo::Client> is a full featured async io HTTP 1.1 and WebSocket client
-with C<IPv6>, C<TLS>, C<epoll> and C<kqueue> support.
+with C<TLS>, C<epoll> and C<kqueue> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
-L<IO::Socket::SSL> are supported transparently and used if installed.
+Optional modules L<IO::KQueue>, L<IO::Epoll> and L<IO::Socket::SSL> are
+supported transparently and used if installed.
=head1 ATTRIBUTES
@@ -1,89 +0,0 @@
-package Mojo::Command::Cgi;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Server::CGI;
-
-use Getopt::Long 'GetOptions';
-
-__PACKAGE__->attr(description => <<'EOF');
-Start application with CGI.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 cgi [OPTIONS]
-
-These options are available:
- --nph Enable non-parsed-header mode.
-EOF
-
-# Hi, Super Nintendo Chalmers!
-sub run {
- my $self = shift;
- my $cgi = Mojo::Server::CGI->new;
-
- # Options
- local @ARGV = @_ if @_;
- GetOptions(nph => sub { $cgi->nph(1) });
-
- # Run
- $cgi->run;
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Cgi - CGI Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::CGI;
-
- my $cgi = Mojo::Command::CGI->new;
- $cgi->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Cgi> is a command interface to L<Mojo::Server::CGI>.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Cgi> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $cgi->description;
- $cgi = $cgi->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $cgi->usage;
- $cgi = $cgi->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Cgi> inherits all methods from L<Mojo::Command> and implements
-the following new ones.
-
-=head2 C<run>
-
- $cgi = $cgi->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,117 +0,0 @@
-package Mojo::Command::Daemon;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Server::Daemon;
-
-use Getopt::Long 'GetOptions';
-
-__PACKAGE__->attr(description => <<'EOF');
-Start application with HTTP 1.1 and WebSocket server.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 daemon [OPTIONS]
-
-These options are available:
- --clients <number> Set maximum number of concurrent clients, defaults
- to 1000.
- --group <name> Set group name for process.
- --keepalive <seconds> Set keep-alive timeout, defaults to 15.
- --listen <locations> Set a comma separated list of locations you want to
- listen on, defaults to http://*:3000.
- --queue <size> Set listen queue size, defaults to SOMAXCONN.
- --reload Automatically reload application when the source
- code changes.
- --requests <number> Set maximum number of requests per keep-alive
- connection, defaults to 100.
- --reverseproxy Activate reverse proxy support, defaults to the
- value of MOJO_REVERSE_PROXY.
- --user <name> Set user name for process.
- --websocket <seconds> Set WebSocket timeout, defaults to 300.
-EOF
-
-
-# This is the worst thing you've ever done.
-# You say that so often that it lost its meaning.
-sub run {
- my $self = shift;
- my $daemon = Mojo::Server::Daemon->new;
-
- # Options
- local @ARGV = @_ if @_;
- GetOptions(
- 'clients=i' => sub { $daemon->max_clients($_[1]) },
- 'group=s' => sub { $daemon->group($_[1]) },
- 'keepalive=i' => sub { $daemon->keep_alive_timeout($_[1]) },
- 'listen=s' => sub { $daemon->listen($_[1]) },
- 'queue=i' => sub { $daemon->listen_queue_size($_[1]) },
- reload => sub { $ENV{MOJO_RELOAD} = 1 },
- 'requests=i' => sub { $daemon->max_requests($_[1]) },
- 'reverseproxy' => sub { $ENV{MOJO_REVERSE_PROXY} = 1 },
- 'user=s' => sub { $daemon->user($_[1]) },
- 'websocket=i' => sub { $daemon->websocket_timeout($_[1]) }
- );
-
- # Run
- $daemon->run;
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Daemon - Daemon Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Daemon;
-
- my $daemon = Mojo::Command::Daemon->new;
- $daemon->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Daemon> is a command interface to
-L<Mojo::Server::Daemon>.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Daemon> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $daemon->description;
- $daemon = $daemon->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $daemon->usage;
- $daemon = $daemon->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Daemon> inherits all methods from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<run>
-
- $daemon = $daemon->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,80 +0,0 @@
-package Mojo::Command::Fastcgi;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Server::FastCGI;
-
-__PACKAGE__->attr(description => <<'EOF');
-Start application with FastCGI.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 fastcgi
-EOF
-
-# Oh boy! Sleep! That's when I'm a Viking!
-sub run {
- my $self = shift;
- my $fastcgi = Mojo::Server::FastCGI->new;
-
- # Run
- $fastcgi->run;
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Fastcgi - FastCGI Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Fastcgi;
-
- my $fastcgi = Mojo::Command::Fastcgi->new;
- $fastcgi->run;
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Fastcgi> is a command interface to L<Mojo::Server::FastCGI>.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::FastCGI> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $fastcgi->description;
- $fastcgi = $fastcgi->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $fastcgi->usage;
- $fastcgi = $fastcgi->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Fastcgi> inherits all methods from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<run>
-
- $fastcgi = $fastcgi->run;
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,123 +0,0 @@
-package Mojo::Command::Get;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Client;
-use Mojo::IOLoop;
-use Mojo::Transaction::HTTP;
-use Mojo::Util 'decode';
-
-use Getopt::Long 'GetOptions';
-
-__PACKAGE__->attr(description => <<'EOF');
-Get file from URL.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 get [OPTIONS] [URL]
-
-These options are available:
- --verbose Print response start line and headers to STDERR.
-EOF
-
-# I hope this has taught you kids a lesson: kids never learn.
-sub run {
- my $self = shift;
-
- # Options
- local @ARGV = @_ if @_;
- my $verbose = 0;
- GetOptions('verbose' => sub { $verbose = 1 });
-
- # URL
- my $url = $ARGV[0];
- die $self->usage unless $url;
- decode 'UTF-8', $url;
-
- # Client
- my $client = Mojo::Client->new(ioloop => Mojo::IOLoop->singleton);
-
- # Silence
- $client->log->level('fatal');
-
- # Application
- $client->app($ENV{MOJO_APP} || 'Mojo::HelloWorld')
- unless $url =~ /^\w+:\/\//;
-
- # Transaction
- my $tx = $client->build_tx(GET => $url);
- $tx->res->body(
- sub {
- my ($res, $chunk) = @_;
- print STDERR $tx->res->build_start_line if $verbose;
- print STDERR $res->headers->to_string, "\n\n" if $verbose;
- print $chunk;
- $verbose = 0;
- }
- );
-
- # Request
- $client->start($tx);
-
- # Error
- my ($message, $code) = $tx->error;
- print qq/Couldn't open page "$url". ($message)\n/ if $message && !$code;
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Get - Get Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Get;
-
- my $get = Mojo::Command::Get->new;
- $get->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Get> is a command interface to L<Mojo::Client>.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Get> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $get->description;
- $get = $get->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $get->usage;
- $get = $get->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Get> inherits all methods from L<Mojo::Command> and implements
-the following new ones.
-
-=head2 C<run>
-
- $get = $get->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,84 +0,0 @@
-package Mojo::Command::Psgi;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Server::PSGI;
-
-# Don't let Krusty's death get you down, boy.
-# People die all the time, just like that.
-# Why, you could wake up dead tomorrow! Well, good night.
-__PACKAGE__->attr(description => <<'EOF');
-Start application with PSGI.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 psgi
-EOF
-
-# D’oh.
-sub run {
- my $self = shift;
- my $psgi = Mojo::Server::PSGI->new;
-
- # Preload
- $psgi->app;
-
- # Return app callback
- return sub { $psgi->run(@_) };
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Psgi - PSGI Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Psgi;
-
- my $psgi = Mojo::Command::Psgi->new;
- my $app = $psgi->run;
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Psgi> is a command interface to L<Mojo::Server::PSGI>.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Psgi> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $psgi->description;
- $psgi = $psgi->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $psgi->usage;
- $psgi = $psgi->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Psgi> inherits all methods from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<run>
-
- my $app = $psgi->run;
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,122 +0,0 @@
-package Mojo::Command::Test;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Cwd;
-use FindBin;
-use File::Spec;
-use Test::Harness;
-
-# Okay folks, show's over. Nothing to see here, show's... Oh my god!
-# A horrible plane crash! Hey everybody, get a load of this flaming wreckage!
-# Come on, crowd around, crowd around!
-__PACKAGE__->attr(description => <<'EOF');
-Run unit tests.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 test [TESTS]
-EOF
-
-# My eyes! The goggles do nothing!
-sub run {
- my ($self, @tests) = @_;
-
- # Search tests
- unless (@tests) {
- my @base = File::Spec->splitdir(File::Spec->abs2rel($FindBin::Bin));
-
- # Test directory in the same directory as "mojo" (t)
- my $path = File::Spec->catdir(@base, 't');
-
- # Test dirctory in the directory above "mojo" (../t)
- $path = File::Spec->catdir(@base, '..', 't') unless -d $path;
- unless (-d $path) {
- print "Can't find test directory.\n";
- return;
- }
-
- # List test files
- my @dirs = ($path);
- while (my $dir = shift @dirs) {
- opendir(my $fh, $dir);
- for my $file (readdir($fh)) {
- next if $file eq '.';
- next if $file eq '..';
- my $fpath = File::Spec->catfile($dir, $file);
- push @dirs, File::Spec->catdir($dir, $file) if -d $fpath;
- push @tests,
- File::Spec->abs2rel(
- Cwd::realpath(
- File::Spec->catfile(File::Spec->splitdir($fpath))
- )
- ) if (-f $fpath) && ($fpath =~ /\.t$/);
- }
- closedir $fh;
- }
-
- $path = Cwd::realpath($path);
- print "Running tests from '$path'.\n";
- }
-
- # Run tests
- runtests(@tests);
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Test - Test Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Test;
-
- my $test = Mojo::Command::Test->new;
- $test->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Test> is a test script.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Test> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $test->description;
- $test = $test->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $test->usage;
- $test = $test->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Test> inherits all methods from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<run>
-
- $test = $test->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,135 +0,0 @@
-package Mojo::Command::Version;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Client;
-use Mojo::IOLoop;
-use Mojo::Server::Daemon;
-use Mojolicious;
-
-__PACKAGE__->attr(description => <<'EOF');
-Show versions of installed modules.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 version
-
-EOF
-
-# If at first you don't succeed, give up.
-sub run {
- my $self = shift;
-
- # Mojo
- my $mojo = $Mojolicious::VERSION;
- my $codename = $Mojolicious::CODENAME;
-
- # Latest version
- my $latest = $mojo;
- eval {
- Mojo::Client->new->max_redirects(3)
- ->get('search.cpan.org/dist/Mojolicious')->res->dom('.version')
- ->each(sub { $latest = $_->text if $_->text =~ /^[\d\.]+$/ });
- };
-
- # Message
- my $message = 'This version is up to date, have fun!';
- $message = 'Thanks for testing a development release, you are awesome!'
- if $latest < $mojo;
- $message = "You might want to update your Mojolicious to $latest."
- if $latest > $mojo;
-
- # Epoll
- my $epoll = Mojo::IOLoop::EPOLL() ? $IO::Epoll::VERSION : 'not installed';
-
- # KQueue
- my $kqueue =
- Mojo::IOLoop::KQUEUE() ? $IO::KQueue::VERSION : 'not installed';
-
- # IPv6
- my $ipv6 =
- Mojo::IOLoop::IPV6() ? $IO::Socket::IP::VERSION : 'not installed';
-
- # TLS
- my $tls =
- Mojo::IOLoop::TLS() ? $IO::Socket::SSL::VERSION : 'not installed';
-
- # Bonjour
- my $bonjour =
- eval 'Mojo::Server::Daemon::BONJOUR()'
- ? $Net::Rendezvous::Publish::VERSION
- : 'not installed';
-
- print <<"EOF";
-CORE
- Perl ($], $^O)
- Mojolicious ($mojo, $codename)
-
-OPTIONAL
- IO::Epoll ($epoll)
- IO::KQueue ($kqueue)
- IO::Socket::IP ($ipv6)
- IO::Socket::SSL ($tls)
- Net::Rendezvous::Publish ($bonjour)
-
-$message
-EOF
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Version - Version Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Version;
-
- my $v = Mojo::Command::Version->new;
- $v->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Version> shows versions of installed modules.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Version> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $v->description;
- $v = $v->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $v->usage;
- $v = $v->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Version> inherits all methods from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<run>
-
- $get = $v->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -11,13 +11,28 @@ require File::Spec;
require IO::File;
use Carp 'croak';
+use Mojo::Server;
use Mojo::Template;
-use Mojo::Util qw/b64_decode decamelize/;
+use Mojo::Loader;
+use Mojo::Util qw/b64_decode camelize decamelize/;
+__PACKAGE__->attr(hint => <<"EOF");
+
+See '$0 help COMMAND' for more information on a specific command.
+EOF
__PACKAGE__->attr(description => 'No description.');
-__PACKAGE__->attr(quiet => 0);
-__PACKAGE__->attr(renderer => sub { Mojo::Template->new });
-__PACKAGE__->attr(usage => "usage: $0\n");
+__PACKAGE__->attr(message => <<"EOF");
+usage: $0 COMMAND [OPTIONS]
+
+Tip: CGI, FastCGI and PSGI environments can be automatically detected very
+ often and work without commands.
+
+These commands are currently available:
+EOF
+__PACKAGE__->attr(namespaces => sub { ['Mojo::Command'] });
+__PACKAGE__->attr(quiet => 0);
+__PACKAGE__->attr(renderer => sub { Mojo::Template->new });
+__PACKAGE__->attr(usage => "usage: $0\n");
sub chmod_file {
my ($self, $path, $mod) = @_;
@@ -84,6 +99,26 @@ sub create_rel_dir {
$self->create_dir($path);
}
+sub detect {
+ my ($self, $guess) = @_;
+
+ # PSGI (Plack only for now)
+ return 'psgi' if defined $ENV{PLACK_ENV};
+
+ # CGI
+ return 'cgi'
+ if defined $ENV{PATH_INFO} || defined $ENV{GATEWAY_INTERFACE};
+
+ # No further detection if we have a guess
+ return $guess if $guess;
+
+ # FastCGI (detect absence of WINDIR for Windows and USER for UNIX)
+ return 'fastcgi' if !defined $ENV{WINDIR} && !defined $ENV{USER};
+
+ # Nothing
+ return;
+}
+
sub get_all_data {
my ($self, $class) = @_;
$class ||= ref $self;
@@ -201,7 +236,128 @@ sub render_to_rel_file {
}
# My cat's breath smells like cat food.
-sub run { croak 'Method "run" not implemented by subclass' }
+sub run {
+ my ($self, $name, @args) = @_;
+
+ # Hypnotoad
+ return return Mojo::Server->new->app if defined $ENV{HYPNOTOAD_APP};
+
+ # Try to detect environment
+ $name = $self->detect($name) unless $ENV{MOJO_NO_DETECT};
+
+ # Run command
+ if ($name && $name =~ /^\w+$/ && ($name ne 'help' || $args[0])) {
+
+ # Help
+ my $help = $name eq 'help' ? 1 : 0;
+ $name = shift @args if $help;
+
+ # Try all namespaces
+ my $module;
+ for my $namespace (@{$self->namespaces}) {
+
+ # Generate module
+ my $camelized = $name;
+ camelize $camelized;
+ my $try = "$namespace\::$camelized";
+
+ # Load
+ if (my $e = Mojo::Loader->load($try)) {
+
+ # Module missing
+ next unless ref $e;
+
+ # Real error
+ die $e;
+ }
+
+ # Module is a command
+ next unless $try->can('new') && $try->can('run');
+
+ # Found
+ $module = $try;
+ last;
+ }
+
+ # Command missing
+ die qq/Command "$name" missing, maybe you need to install it?\n/
+ unless $module;
+
+ # Run
+ my $command = $module->new;
+ return $help ? $command->help : $command->run(@args);
+ }
+
+ # Test
+ return $self if $ENV{HARNESS_ACTIVE};
+
+ # Try all namespaces
+ my $commands = [];
+ my $seen = {};
+ for my $namespace (@{$self->namespaces}) {
+
+ # Search
+ if (my $modules = Mojo::Loader->search($namespace)) {
+ for my $module (@$modules) {
+
+ # Load
+ if (my $e = Mojo::Loader->load($module)) { die $e }
+
+ # Seen
+ my $command = $module;
+ $command =~ s/^$namespace\:://;
+ push @$commands, [$command => $module]
+ unless $seen->{$command};
+ $seen->{$command} = 1;
+ }
+ }
+ }
+
+ # Print overview
+ print $self->message;
+
+ # Make list
+ my $list = [];
+ my $length = 0;
+ foreach my $command (@$commands) {
+
+ # Generate name
+ my $name = $command->[0];
+ decamelize $name;
+
+ # Add to list
+ my $l = length $name;
+ $length = $l if $l > $length;
+ push @$list, [$name, $command->[1]->new->description];
+ }
+
+ # Print list
+ foreach my $command (@$list) {
+ my $name = $command->[0];
+ my $description = $command->[1];
+ my $padding = ' ' x ($length - length $name);
+ print " $name$padding $description";
+ }
+
+ # Hint
+ print $self->hint;
+
+ return $self;
+}
+
+sub start {
+ my $self = shift;
+
+ # Don't run commands if we are reloading
+ return $self if $ENV{MOJO_COMMANDS_DONE};
+ $ENV{MOJO_COMMANDS_DONE} ||= 1;
+
+ # Arguments
+ my @args = @_ ? @_ : @ARGV;
+
+ # Run
+ return ref $self ? $self->run(@args) : $self->new->run(@args);
+}
sub write_file {
my ($self, $path, $data) = @_;
@@ -278,7 +434,8 @@ Mojo::Command - Command Base Class
=head1 DESCRIPTION
L<Mojo::Command> is an abstract base class for L<Mojo> commands.
-See L<Mojo::Commands> for a list of commands that are available by default.
+See L<Mojolicious::Commands> for a list of commands that are available by
+default.
=head1 ATTRIBUTES
@@ -291,6 +448,27 @@ L<Mojo::Command> implements the following attributes.
Short description of command, used for the command list.
+=head2 C<hint>
+
+ my $hint = $commands->hint;
+ $commands = $commands->hint('Foo!');
+
+Short hint shown after listing available commands.
+
+=head2 C<message>
+
+ my $message = $commands->message;
+ $commands = $commands->message('Hello World!');
+
+Short usage message shown before listing available commands.
+
+=head2 C<namespaces>
+
+ my $namespaces = $commands->namespaces;
+ $commands = $commands->namespaces(['Mojolicious::Commands']);
+
+Namespaces to search for available commands, defaults to L<Mojo::Command>.
+
=head2 C<quiet>
my $quiet = $command->quiet;
@@ -350,6 +528,13 @@ Portably create a directory.
Portably create a relative directory.
+=head2 C<detect>
+
+ my $env = $commands->detect;
+ my $env = $commands->detect($guess);
+
+Try to detect environment.
+
=head2 C<get_all_data>
my $all = $command->get_all_data;
@@ -403,9 +588,17 @@ relative file.
=head2 C<run>
- $command = $command->run(@ARGV);
+ $commands->run;
+ $commands->run(@ARGV);
+
+Load and run commands.
+
+=head2 C<start>
+
+ Mojo::Command->start;
+ Mojo::Command->start(@ARGV);
-Run command.
+Start the command line interface.
=head2 C<write_file>
@@ -1,309 +0,0 @@
-package Mojo::Commands;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Loader;
-use Mojo::Util qw/camelize decamelize/;
-
-__PACKAGE__->attr(hint => <<"EOF");
-
-See '$0 help COMMAND' for more information on a specific command.
-EOF
-__PACKAGE__->attr(message => <<"EOF");
-usage: $0 COMMAND [OPTIONS]
-
-Tip: CGI, FastCGI and PSGI environments can be automatically detected very
- often and work without commands.
-
-These commands are currently available:
-EOF
-__PACKAGE__->attr(namespaces => sub { ['Mojo::Command'] });
-
-# Aren't we forgetting the true meaning of Christmas?
-# You know, the birth of Santa.
-sub detect {
- my ($self, $guess) = @_;
-
- # Hypnotoad
- return 'hypnotoad' if defined $ENV{HYPNOTOAD_APP};
-
- # PSGI (Plack only for now)
- return 'psgi' if defined $ENV{PLACK_ENV};
-
- # CGI
- return 'cgi'
- if defined $ENV{PATH_INFO} || defined $ENV{GATEWAY_INTERFACE};
-
- # No further detection if we have a guess
- return $guess if $guess;
-
- # FastCGI (detect absence of WINDIR for Windows and USER for UNIX)
- return 'fastcgi' if !defined $ENV{WINDIR} && !defined $ENV{USER};
-
- # Nothing
- return;
-}
-
-sub run {
- my ($self, $name, @args) = @_;
-
- # Try to detect environment
- $name = $self->detect($name) unless $ENV{MOJO_NO_DETECT};
-
- # Run command
- if ($name && $name =~ /^\w+$/ && ($name ne 'help' || $args[0])) {
-
- # Help
- my $help = $name eq 'help' ? 1 : 0;
- $name = shift @args if $help;
-
- # Try all namespaces
- my $module;
- for my $namespace (@{$self->namespaces}) {
-
- # Generate module
- my $camelized = $name;
- camelize $camelized;
- my $try = "$namespace\::$camelized";
-
- # Load
- if (my $e = Mojo::Loader->load($try)) {
-
- # Module missing
- next unless ref $e;
-
- # Real error
- die $e;
- }
-
- # Module is a command
- next unless $try->can('new') && $try->can('run');
-
- # Found
- $module = $try;
- last;
- }
-
- # Command missing
- die qq/Command "$name" missing, maybe you need to install it?\n/
- unless $module;
-
- # Run
- my $command = $module->new;
- return $help ? $command->help : $command->run(@args);
- }
-
- # Test
- return $self if $ENV{HARNESS_ACTIVE};
-
- # Try all namespaces
- my $commands = [];
- my $seen = {};
- for my $namespace (@{$self->namespaces}) {
-
- # Search
- if (my $modules = Mojo::Loader->search($namespace)) {
- for my $module (@$modules) {
-
- # Load
- if (my $e = Mojo::Loader->load($module)) { die $e }
-
- # Seen
- my $command = $module;
- $command =~ s/^$namespace\:://;
- push @$commands, [$command => $module]
- unless $seen->{$command};
- $seen->{$command} = 1;
- }
- }
- }
-
- # Print overview
- print $self->message;
-
- # Make list
- my $list = [];
- my $length = 0;
- foreach my $command (@$commands) {
-
- # Generate name
- my $name = $command->[0];
- decamelize $name;
-
- # Add to list
- my $l = length $name;
- $length = $l if $l > $length;
- push @$list, [$name, $command->[1]->new->description];
- }
-
- # Print list
- foreach my $command (@$list) {
- my $name = $command->[0];
- my $description = $command->[1];
- my $padding = ' ' x ($length - length $name);
- print " $name$padding $description";
- }
-
- # Hint
- print $self->hint;
-
- return $self;
-}
-
-sub start {
- my $self = shift;
-
- # Don't run commands if we are reloading
- return $self if $ENV{MOJO_COMMANDS_DONE};
- $ENV{MOJO_COMMANDS_DONE} ||= 1;
-
- # Arguments
- my @args = @_ ? @_ : @ARGV;
-
- # Run
- return ref $self ? $self->run(@args) : $self->new->run(@args);
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Commands - Commands
-
-=head1 SYNOPSIS
-
- use Mojo::Commands;
-
- # Command line interface
- my $commands = Mojo::Commands->new;
- $commands->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Commands> is the interactive command line interface to the L<Mojo>
-framework.
-It will automatically detect available commands in the L<Mojo::Command>
-namespace.
-Commands are implemented by subclassing L<Mojo::Command>.
-
-These commands are available by default.
-
-=over 4
-
-=item C<help>
-
- mojo
- mojo help
-
-List available commands with short descriptions.
-
- mojo help <command>
-
-List available options for the command with short descriptions.
-
-=item C<cgi>
-
- mojo cgi
- script/myapp cgi
-
-Start application with CGI backend.
-
-=item C<daemon>
-
- mojo cgi
- script/myapp daemon
-
-Start application with standalone HTTP 1.1 server backend.
-
-=item C<fastcgi>
-
- mojo fastcgi
- script/myapp fastcgi
-
-Start application with FastCGI backend.
-
-=item C<get>
-
- mojo get http://mojolicious.org
- script/myapp get /foo
-
-Perform GET request to remote host or local application.
-
-=item C<test>
-
- mojo test
- script/myapp test
- script/myapp test t/foo.t
-
-Runs application tests from the C<t> directory.
-
-=item C<version>
-
- mojo version
-
-List version information for installed core and optional modules, very useful
-for debugging.
-
-=back
-
-=head1 ATTRIBUTES
-
-L<Mojo::Commands> inherits all attributes from L<Mojo::Command> and
-implements the following new ones.
-
-=head2 C<hint>
-
- my $hint = $commands->hint;
- $commands = $commands->hint('Foo!');
-
-Short hint shown after listing available commands.
-
-=head2 C<message>
-
- my $message = $commands->message;
- $commands = $commands->message('Hello World!');
-
-Short usage message shown before listing available commands.
-
-=head2 C<namespaces>
-
- my $namespaces = $commands->namespaces;
- $commands = $commands->namespaces(['Mojo::Command']);
-
-Namespaces to search for available commands, defaults to L<Mojo::Command>.
-
-=head1 METHODS
-
-L<Mojo::Commands> inherits all methods from L<Mojo::Command> and implements
-the following new ones.
-
-=head2 C<detect>
-
- my $env = $commands->detect;
- my $env = $commands->detect($guess);
-
-Try to detect environment.
-
-=head2 C<run>
-
- $commands->run;
- $commands->run(@ARGV);
-
-Load and run commands.
-
-=head2 C<start>
-
- Mojo::Commands->start;
- Mojo::Commands->start(@ARGV);
-
-Start the command line interface.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -68,8 +68,8 @@ sub build_headers {
return $headers;
}
-sub finish { shift->{_eof} = 1 }
-
+# Aren't we forgetting the true meaning of Christmas?
+# You know, the birth of Santa.
sub generate_body_chunk {
my ($self, $offset) = @_;
@@ -300,7 +300,7 @@ sub write_chunk {
$self->write(defined $chunk ? $self->_build_chunk($chunk) : $chunk, $cb);
# Finish
- $self->finish if defined $chunk && $chunk eq '';
+ $self->{_eof} = 1 if defined $chunk && $chunk eq '';
}
sub _build_chunk {
@@ -504,13 +504,6 @@ Render whole body.
Render all headers.
-=head2 C<finish>
-
- $content->finish;
-
-Finish dynamic content generation.
-Note that this method is EXPERIMENTAL and might change without warning!
-
=head2 C<generate_body_chunk>
my $chunk = $content->generate_body_chunk(0);
@@ -1394,9 +1394,9 @@ Children of element.
=head2 C<find>
- my $results = $dom->find('html title');
+ my $collection = $dom->find('html title');
-Find elements with CSS3 selectors.
+Find elements with CSS3 selectors and return a collection.
print $dom->find('div')->[23]->text;
$dom->find('div')->each(sub { print shift->text });
@@ -25,7 +25,7 @@ sub new {
# Trace name and line
my @trace;
- while ($message =~ /at\s+(.+)\s+line\s+(\d+)/g) {
+ while ($message =~ /at\s+(.+?)\s+line\s+(\d+)/g) {
push @trace, {file => $1, line => $2};
}
@@ -129,8 +129,7 @@ sub from_hash {
}
# Merge
- foreach my $header (keys %{$hash}) {
- my $value = $hash->{$header};
+ while (my ($header, $value) = each %$hash) {
$self->add($header => ref $value eq 'ARRAY' ? @$value : $value);
}
@@ -11,6 +11,7 @@ use File::Spec;
use IO::File;
use IO::Poll qw/POLLERR POLLHUP POLLIN POLLOUT/;
use IO::Socket;
+use List::Util 'first';
use Mojo::URL;
use Scalar::Util 'weaken';
use Socket qw/IPPROTO_TCP TCP_NODELAY/;
@@ -19,8 +20,12 @@ use Time::HiRes 'time';
# Debug
use constant DEBUG => $ENV{MOJO_IOLOOP_DEBUG} || 0;
+# Perl 5.12 required for "inet_pton"
+use constant PTON => eval 'use 5.012000; 1';
+use constant PTON_AF_INET6 => PTON ? Socket::AF_INET6() : 0;
+
# Epoll support requires IO::Epoll
-use constant EPOLL => ($ENV{MOJO_POLL} || $ENV{MOJO_KQUEUE})
+use constant EPOLL => $ENV{MOJO_POLL}
? 0
: eval 'use IO::Epoll 0.02 (); 1';
use constant EPOLL_POLLERR => EPOLL ? IO::Epoll::POLLERR() : 0;
@@ -28,13 +33,8 @@ use constant EPOLL_POLLHUP => EPOLL ? IO::Epoll::POLLHUP() : 0;
use constant EPOLL_POLLIN => EPOLL ? IO::Epoll::POLLIN() : 0;
use constant EPOLL_POLLOUT => EPOLL ? IO::Epoll::POLLOUT() : 0;
-# IPv6 support requires IO::Socket::IP
-use constant IPV6 => $ENV{MOJO_NO_IPV6}
- ? 0
- : eval 'use IO::Socket::IP 0.04 (); 1';
-
# KQueue support requires IO::KQueue
-use constant KQUEUE => ($ENV{MOJO_POLL} || $ENV{MOJO_EPOLL})
+use constant KQUEUE => $ENV{MOJO_POLL}
? 0
: eval 'use IO::KQueue 0.34 (); 1';
use constant KQUEUE_ADD => KQUEUE ? IO::KQueue::EV_ADD() : 0;
@@ -44,9 +44,9 @@ use constant KQUEUE_READ => KQUEUE ? IO::KQueue::EVFILT_READ() : 0;
use constant KQUEUE_WRITE => KQUEUE ? IO::KQueue::EVFILT_WRITE() : 0;
# TLS support requires IO::Socket::SSL
-use constant TLS => $ENV{MOJO_NO_TLS} ? 0
- : IPV6 ? eval 'use IO::Socket::SSL 1.33 (); 1'
- : eval 'use IO::Socket::SSL 1.33 "inet4"; 1';
+use constant TLS => $ENV{MOJO_NO_TLS}
+ ? 0
+ : eval 'use IO::Socket::SSL 1.34 "inet4"; 1';
use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
@@ -120,9 +120,14 @@ if (-r '/etc/resolv.conf') {
# DNS record types
my $DNS_TYPES = {
- A => 0x0001,
- AAAA => 0x001c,
- TXT => 0x0010
+ '*' => 0x00ff,
+ A => 0x0001,
+ AAAA => 0x001c,
+ CNAME => 0x0005,
+ MX => 0x000f,
+ NS => 0x0002,
+ PTR => 0x000c,
+ TXT => 0x0010
};
# "localhost"
@@ -131,13 +136,12 @@ our $LOCALHOST = '127.0.0.1';
__PACKAGE__->attr([qw/accept_timeout connect_timeout dns_timeout/] => 3);
__PACKAGE__->attr(dns_server => sub { $ENV{MOJO_DNS_SERVER} || $DNS_SERVER });
__PACKAGE__->attr(max_connections => 1000);
-__PACKAGE__->attr([qw/on_idle on_tick/]);
__PACKAGE__->attr(
[qw/on_lock on_unlock/] => sub {
sub {1}
}
);
-__PACKAGE__->attr(timeout => '0.25');
+__PACKAGE__->attr(timeout => '0.025');
# Singleton
our $LOOP;
@@ -154,6 +158,12 @@ our $LOOP;
sub DESTROY {
my $self = shift;
+ # Cleanup connections
+ for my $id (keys %{$self->{_cs}}) { $self->_drop_immediately($id) }
+
+ # Cleanup listen sockets
+ for my $id (keys %{$self->{_listen}}) { $self->_drop_immediately($id) }
+
# Cleanup temporary cert file
if (my $cert = $self->{_cert}) { unlink $cert if -w $cert }
@@ -193,7 +203,8 @@ sub connect {
on_connect => $args->{on_connect}
|| $args->{connect_cb}
|| $args->{cb},
- connecting => 1
+ connecting => 1,
+ tls => $args->{tls}
};
(my $id) = "$c" =~ /0x([\da-f]+)/;
$self->{_cs}->{$id} = $c;
@@ -206,7 +217,7 @@ sub connect {
}
# Lookup
- if (my $address = $args->{address}) {
+ if (!$args->{handle} && (my $address = $args->{address})) {
$self->lookup(
$address => sub {
my $self = shift;
@@ -237,7 +248,7 @@ sub connection_timeout {
sub drop {
my ($self, $id) = @_;
- # Connection
+ # Drop connection gracefully
if (my $c = $self->{_cs}->{$id}) { return $c->{finish} = 1 }
# Drop
@@ -276,12 +287,12 @@ sub listen {
my $args = ref $_[0] ? $_[0] : {@_};
# TLS check
- croak "IO::Socket::SSL 1.33 required for TLS support"
+ croak "IO::Socket::SSL 1.34 required for TLS support"
if $args->{tls} && !TLS;
# Options
my %options = (
- Listen => $args->{queue_size} || SOMAXCONN,
+ Listen => $args->{backlog} || SOMAXCONN,
Proto => 'tcp',
Type => SOCK_STREAM,
%{$args->{args} || {}}
@@ -310,6 +321,9 @@ sub listen {
(my $id) = "$c" =~ /0x([\da-f]+)/;
$self->{_listen}->{$id} = $c;
+ # Allow file descriptor inheritance
+ local $^F = 1000;
+
# Listen on UNIX domain socket
my $socket;
if (defined $file) {
@@ -329,14 +343,16 @@ sub listen {
else {
# Socket options
- $options{LocalAddr} = $args->{address} || (IPV6 ? '::' : '0.0.0.0');
+ $options{LocalAddr} = $args->{address} || '0.0.0.0';
$options{LocalPort} = $port;
$options{Proto} = 'tcp';
$options{ReuseAddr} = 1;
# Create socket
- my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
- $socket = defined $fd ? $class->new : $class->new(%options)
+ $socket =
+ defined $fd
+ ? IO::Socket::INET->new
+ : IO::Socket::INET->new(%options)
or croak "Can't create listen socket: $!";
}
@@ -353,7 +369,7 @@ sub listen {
$self->{_fds}->{$fd} = $id;
# Socket
- $c->{socket} = $socket;
+ $c->{handle} = $socket;
$self->{_reverse}->{$socket} = $id;
# TLS options
@@ -374,7 +390,7 @@ sub local_info {
return {} unless my $c = $self->{_cs}->{$id};
# Socket
- return {} unless my $socket = $c->{socket};
+ return {} unless my $socket = $c->{handle};
# UNIX domain socket info
return {path => $socket->hostpath} if $socket->can('hostpath');
@@ -397,7 +413,8 @@ sub lookup {
my ($self, $results) = @_;
# Success
- return $self->$cb($results->[0]) if $results->[0];
+ my $result = first { $_->[0] eq 'A' } @$results;
+ return $self->$cb($result->[1]) if $result;
# IPv6
$self->resolve(
@@ -406,7 +423,8 @@ sub lookup {
my ($self, $results) = @_;
# Success
- return $self->$cb($results->[0]) if $results->[0];
+ my $result = first { $_->[0] eq 'AAAA' } @$results;
+ return $self->$cb($result->[1]) if $result;
# Pass through
$self->$cb();
@@ -418,7 +436,9 @@ sub lookup {
sub on_error { shift->_add_event('error', @_) }
sub on_hup { shift->_add_event('hup', @_) }
-sub on_read { shift->_add_event('read', @_) }
+sub on_idle { shift->_add_loop_event('idle', @_) }
+sub on_read { shift->_add_event('read', @_) }
+sub on_tick { shift->_add_loop_event('tick', @_) }
sub one_tick {
my ($self, $timeout) = @_;
@@ -520,14 +540,14 @@ sub one_tick {
# Timers
my $timers = $self->_timer;
- # Tick callback
- if (my $cb = $self->on_tick) {
- $self->_run_callback('tick', $cb);
+ # Tick
+ for my $tick (keys %{$self->{_tick}}) {
+ $self->_run_callback('tick', $self->{_tick}->{$tick}->{cb}, $tick);
}
- # Idle callback
- if (my $cb = $self->on_idle) {
- $self->_run_callback('idle', $cb)
+ # Idle
+ for my $idle (keys %{$self->{_idle}}) {
+ $self->_run_callback('idle', $self->{_idle}->{$idle}->{cb}, $idle)
unless @read || @write || @error || @hup || $timers;
}
}
@@ -539,7 +559,7 @@ sub remote_info {
return {} unless my $c = $self->{_cs}->{$id};
# Socket
- return {} unless my $socket = $c->{socket};
+ return {} unless my $socket = $c->{handle};
# UNIX domain socket info
return {path => $socket->peerpath} if $socket->can('peerpath');
@@ -552,8 +572,10 @@ sub resolve {
my ($self, $name, $type, $cb) = @_;
# Regex
- my $ipv4 = $Mojo::URL::IPV4_RE;
- my $ipv6 = $Mojo::URL::IPV6_RE;
+ my $ipv4;
+ $ipv4 = 1 if $name =~ $Mojo::URL::IPV4_RE;
+ my $ipv6;
+ $ipv6 = 1 if PTON && $name =~ $Mojo::URL::IPV6_RE;
# Type
my $t = $DNS_TYPES->{$type};
@@ -562,7 +584,7 @@ sub resolve {
my $server = $self->dns_server;
# No lookup required or record type not supported
- unless ($server && $t && $name !~ $ipv4 && $name !~ $ipv6) {
+ if (!$server || !$t || ($t ne $DNS_TYPES->{PTR} && ($ipv4 || $ipv6))) {
$self->timer(0 => sub { $self->$cb([]) });
return $self;
}
@@ -587,8 +609,24 @@ sub resolve {
# Header (one question with recursion)
my $req = pack 'nnnnnn', $tx, 0x0100, 1, 0, 0, 0;
+ # Parts
+ my @parts = split /\./, $name;
+
+ # Reverse
+ if ($t eq $DNS_TYPES->{PTR}) {
+
+ # IPv4
+ if ($ipv4) { @parts = reverse 'arpa', 'in-addr', @parts }
+
+ # IPv6
+ elsif ($ipv6) {
+ @parts = reverse 'arpa', 'ip6', split //, unpack 'H32',
+ Socket::inet_pton(PTON_AF_INET6, $name);
+ }
+ }
+
# Query (Internet)
- for my $part (split /\./, $name) {
+ for my $part (@parts) {
$req .= pack 'C/a', $part if defined $part;
}
$req .= pack 'Cnn', 0, $t, 0x0001;
@@ -615,6 +653,9 @@ sub resolve {
# Packet
my @packet = unpack 'nnnnnna*', $chunk;
+ # Debug
+ warn "ANSWERS $packet[3] ($server)\n" if DEBUG;
+
# Wrong response
return $self->$cb([]) unless $packet[0] eq $tx;
@@ -624,37 +665,28 @@ sub resolve {
# Questions
for (1 .. $packet[2]) {
my $n;
- do { ($n, $content) = unpack 'C/aa*', $content } while ($n);
+ do { ($n, $content) = unpack 'C/aa*', $content }
+ while ($n ne '');
$content = (unpack 'nna*', $content)[2];
}
# Answers
my @answers;
for (1 .. $packet[3]) {
- my ($t, $a, $answer);
- ($t, $a, $content) = (unpack 'nnnNn/aa*', $content)[1, 4, 5];
- # A
- if ($t eq $DNS_TYPES->{A}) {
- $answer = join('.', unpack 'C4', $a);
- }
+ # Parse
+ (my ($t, $a), $content) =
+ (unpack 'nnnNn/aa*', $content)[1, 4, 5];
+ my @answer = _parse_answer($t, $a, $chunk, $content);
- # AAAA
- elsif ($t eq $DNS_TYPES->{AAAA}) {
- $answer = sprintf '%x:%x:%x:%x:%x:%x:%x:%x',
- unpack('n*', $a);
- }
+ # No answer
+ next unless @answer;
- # TXT
- elsif ($t eq $DNS_TYPES->{TXT}) {
- $answer = unpack '(C/a*)*', $a;
- }
-
- next unless defined $answer;
- push @answers, $answer;
+ # Answer
+ push @answers, \@answer;
# Debug
- warn "ANSWER $answer\n" if DEBUG;
+ warn "ANSWER $answer[0] $answer[1]\n" if DEBUG;
}
# Done
@@ -670,9 +702,6 @@ sub resolve {
# Debug
warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
- # Disable
- $self->dns_server(undef);
-
# Abort
$self->drop($id);
$self->$cb([]);
@@ -720,7 +749,7 @@ sub start_tls {
$self->drop($id) and return unless my $c = $self->{_cs}->{$id};
# Socket
- $self->drop($id) and return unless my $socket = $c->{socket};
+ $self->drop($id) and return unless my $socket = $c->{handle};
my $fd = fileno $socket;
# Cleanup
@@ -738,7 +767,7 @@ sub start_tls {
unless my $new = IO::Socket::SSL->start_SSL($socket, %options);
# Upgrade
- $c->{socket} = $new;
+ $c->{handle} = $new;
$self->{_reverse}->{$new} = $id;
$c->{tls_connect} = 1;
$self->_writing($id);
@@ -755,7 +784,7 @@ sub test {
return unless my $c = $self->{_cs}->{$id};
# Socket
- return unless my $socket = $c->{socket};
+ return unless my $socket = $c->{handle};
# Test
my $test = $self->{_test} ||= IO::Poll->new;
@@ -768,16 +797,7 @@ sub test {
}
sub timer {
- my ($self, $after, $cb) = @_;
-
- # Timer
- my $timer = {after => $after, cb => $cb, started => time};
-
- # Add timer
- (my $id) = "$timer" =~ /0x([\da-f]+)/;
- $self->{_ts}->{$id} = $timer;
-
- return $id;
+ shift->_add_loop_event(timer => pop, after => pop, started => time);
}
sub write {
@@ -825,27 +845,19 @@ sub _accept {
weaken $self;
# Connection
- my $c = {
- accepting => 1,
- buffer => '',
- };
+ my $c = {buffer => ''};
(my $id) = "$c" =~ /0x([\da-f]+)/;
$self->{_cs}->{$id} = $c;
# TLS handshake
my $tls = $l->{tls};
- if ($tls) {
- $tls->{SSL_error_trap} = sub { $self->_drop_immediately(shift) };
- $socket = IO::Socket::SSL->start_SSL($socket, %$tls);
- }
+ $socket = IO::Socket::SSL->start_SSL($socket, %$tls) if $tls;
$c->{tls_accept} = 1 if $tls;
- $c->{socket} = $socket;
+ $c->{handle} = $socket;
$r->{$socket} = $id;
- # Timeout
- $c->{accept_timer} =
- $self->timer($self->accept_timeout, =>
- sub { shift->_error($id, 'Accept timeout.') });
+ # Non-blocking
+ $socket->blocking(0);
# Disable Nagle's algorithm
setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1) unless $l->{file};
@@ -860,15 +872,21 @@ sub _accept {
$self->$name($id => $cb) if $cb;
}
+ # Add socket to poll
+ $self->_not_writing($id);
+
+ # Debug
+ warn "ACCEPTED $id\n" if DEBUG;
+
# Accept callback
- my $cb = $l->{on_accept};
- $self->_run_event('accept', $cb, $id) if $cb;
+ my $cb = $c->{on_accept} = $l->{on_accept};
+ $self->_run_event('accept', $cb, $id) if $cb && !$l->{tls};
# Remove listen sockets
$listen = $self->{_listen} || {};
my $loop = $self->{_loop};
for my $lid (keys %$listen) {
- my $socket = $listen->{$lid}->{socket};
+ my $socket = $listen->{$lid}->{handle};
# Remove listen socket from kqueue
if (KQUEUE) {
@@ -895,6 +913,21 @@ sub _add_event {
return $self;
}
+sub _add_loop_event {
+ my $self = shift;
+ my $event = shift;
+ my $cb = shift;
+
+ # Event
+ my $e = {cb => $cb, @_};
+
+ # Add event
+ (my $id) = "$e" =~ /0x([\da-f]+)/;
+ $self->{"_$event"}->{$id} = $e;
+
+ return $id;
+}
+
sub _connect {
my ($self, $id, $args) = @_;
@@ -903,6 +936,7 @@ sub _connect {
# Options
my %options = (
+ Blocking => 0,
PeerAddr => $args->{address},
PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
Proto => $args->{proto},
@@ -910,30 +944,34 @@ sub _connect {
%{$args->{args} || {}}
);
- # Socket
- my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
- return $self->_error($id, "Couldn't connect.")
- unless my $socket = $args->{socket} || $class->new(%options);
- $c->{socket} = $socket;
- $self->{_reverse}->{$socket} = $id;
+ # Handle
+ my $handle;
+ unless ($handle = $args->{handle} || $args->{socket}) {
- # File descriptor
- return unless defined(my $fd = fileno $socket);
- $self->{_fds}->{$fd} = $id;
+ # Socket
+ return $self->_error($id, "Couldn't connect.")
+ unless $handle = IO::Socket::INET->new(%options);
- # Non-blocking
- $socket->blocking(0);
+ # Disable Nagle's algorithm
+ setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
- # Disable Nagle's algorithm
- setsockopt $socket, IPPROTO_TCP, TCP_NODELAY, 1;
+ # Timer
+ $c->{connect_timer} =
+ $self->timer($self->connect_timeout =>
+ sub { shift->_error($id, 'Connect timeout.') });
+ }
+ $c->{handle} = $handle;
+ $self->{_reverse}->{$handle} = $id;
- # Timer
- $c->{connect_timer} =
- $self->timer($self->connect_timeout =>
- sub { shift->_error($id, 'Connect timeout.') });
+ # Non-blocking
+ $handle->blocking(0);
- # Add socket to poll
- $self->_not_writing($id);
+ # File descriptor
+ return unless defined(my $fd = fileno $handle);
+ $self->{_fds}->{$fd} = $id;
+
+ # Add handle to poll
+ $self->_writing($id);
# Start TLS
if ($args->{tls}) { $self->start_tls($id => $args) }
@@ -942,12 +980,14 @@ sub _connect {
sub _drop_immediately {
my ($self, $id) = @_;
- # Drop timer
- if ($self->{_ts}->{$id}) {
+ # Drop loop events
+ for my $event (qw/idle tick timer/) {
+ if ($self->{"_$event"}->{$id}) {
- # Drop
- delete $self->{_ts}->{$id};
- return $self;
+ # Drop
+ delete $self->{"_$event"}->{$id};
+ return $self;
+ }
}
# Delete connection
@@ -969,14 +1009,17 @@ sub _drop_immediately {
$self->_drop_immediately($t);
}
- # Drop socket
- if (my $socket = $c->{socket}) {
+ # Drop handle
+ if (my $handle = $c->{handle}) {
+
+ # Debug
+ warn "DISCONNECTED $id\n" if DEBUG;
# Remove file descriptor
- return unless my $fd = fileno $socket;
+ return unless my $fd = fileno $handle;
delete $self->{_fds}->{$fd};
- # Remove socket from kqueue
+ # Remove handle from kqueue
if (my $loop = $self->_prepare_loop) {
if (KQUEUE) {
@@ -987,12 +1030,12 @@ sub _drop_immediately {
$loop->EV_SET($fd, KQUEUE_WRITE, KQUEUE_DELETE) if $writing;
}
- # Remove socket from poll or epoll
- else { $loop->remove($socket) }
+ # Remove handle from poll or epoll
+ else { $loop->remove($handle) }
}
- # Close socket
- close $socket;
+ # Close handle
+ close $handle;
}
return $self;
@@ -1045,8 +1088,8 @@ sub _not_writing {
# Chunk still in buffer
return $c->{read_only} = 1 if length $c->{buffer};
- # Socket
- return unless my $socket = $c->{socket};
+ # Handle
+ return unless my $handle = $c->{handle};
# Writing
my $writing = $c->{writing};
@@ -1055,7 +1098,7 @@ sub _not_writing {
# KQueue
my $loop = $self->_prepare_loop;
if (KQUEUE) {
- my $fd = fileno $socket;
+ my $fd = fileno $handle;
# Writing
$loop->EV_SET($fd, KQUEUE_READ, KQUEUE_ADD) unless defined $writing;
@@ -1067,39 +1110,87 @@ sub _not_writing {
# Not writing anymore
if ($writing) {
- $loop->remove($socket);
+ $loop->remove($handle);
$writing = undef;
}
# Reading
my $mask = EPOLL ? EPOLL_POLLIN : POLLIN;
- $loop->mask($socket, $mask) unless defined $writing;
+ $loop->mask($handle, $mask) unless defined $writing;
}
# Not writing anymore
$c->{writing} = 0;
}
-sub _prepare_accept {
- my ($self, $id) = @_;
+# Answer helper for "resolve"
+sub _parse_answer {
+ my ($t, $a, $packet, $rest) = @_;
- # Connection
- my $c = $self->{_cs}->{$id};
+ # A
+ if ($t eq $DNS_TYPES->{A}) { return A => join('.', unpack 'C4', $a) }
- # Connected
- return unless $c->{socket}->connected;
+ # AAAA
+ elsif ($t eq $DNS_TYPES->{AAAA}) {
+ return AAAA => sprintf('%x:%x:%x:%x:%x:%x:%x:%x', unpack('n*', $a));
+ }
- # Accepted
- delete $c->{accepting};
+ # TXT
+ elsif ($t eq $DNS_TYPES->{TXT}) { return TXT => unpack('(C/a*)*', $a) }
- # Remove timeout
- $self->_drop_immediately(delete $c->{accept_timer});
+ # Offset
+ my $offset = length($packet) - length($rest) - length($a);
- # Non-blocking
- $c->{socket}->blocking(0);
+ # CNAME
+ my $type;
+ if ($t eq $DNS_TYPES->{CNAME}) { $type = 'CNAME' }
- # Add socket to poll
- $self->_not_writing($id);
+ # MX
+ elsif ($t eq $DNS_TYPES->{MX}) {
+ $type = 'MX';
+ $offset += 2;
+ }
+
+ # NS
+ elsif ($t eq $DNS_TYPES->{NS}) { $type = 'NS' }
+
+ # PTR
+ elsif ($t eq $DNS_TYPES->{PTR}) { $type = 'PTR' }
+
+ # Domain name
+ return $type => _parse_name($packet, $offset) if $type;
+
+ # Not supported
+ return;
+}
+
+# Domain name helper for "resolve"
+sub _parse_name {
+ my ($packet, $offset) = @_;
+
+ # Elements
+ my @elements;
+ for (1 .. 128) {
+
+ # Element length
+ my $length = ord substr $packet, $offset++, 1;
+
+ # Offset
+ if ($length >= 0xc0) {
+ $offset = (unpack 'n', substr $packet, ++$offset - 2, 2) & 0x3fff;
+ }
+
+ # Element
+ elsif ($length) {
+ push @elements, substr $packet, $offset, $length;
+ $offset += $length;
+ }
+
+ # Zero length element (the end)
+ else { return join '.', @elements }
+ }
+
+ return;
}
sub _prepare_cert {
@@ -1120,27 +1211,6 @@ sub _prepare_cert {
return $self->{_cert} = $cert;
}
-sub _prepare_connect {
- my ($self, $id) = @_;
-
- # Connection
- my $c = $self->{_cs}->{$id};
-
- # Not yet connected
- return unless my $socket = $c->{socket};
- if ($socket->can('connected')) { return unless $socket->connected }
-
- # Connected
- delete $c->{connecting};
-
- # Remove timeout
- $self->_drop_immediately(delete $c->{connect_timer});
-
- # Connect callback
- my $cb = $c->{on_connect};
- $self->_run_event('connect', $cb, $id) if $cb;
-}
-
sub _prepare_connections {
my $self = shift;
@@ -1150,20 +1220,12 @@ sub _prepare_connections {
# Prepare
while (my ($id, $c) = each %$cs) {
- # Accepting
- $self->_prepare_accept($id) if $c->{accepting};
-
- # Connecting
- $self->_prepare_connect($id) if $c->{connecting};
-
# Connection needs to be finished
- if ($c->{finish}) {
+ if ($c->{finish} && !length $c->{buffer}) {
# Buffer empty
- unless (length $c->{buffer}) {
- $self->_drop_immediately($id);
- next;
- }
+ $self->_drop_immediately($id);
+ next;
}
# Read only
@@ -1220,7 +1282,7 @@ sub _prepare_listen {
# Add listen sockets
for my $lid (keys %$listen) {
- my $socket = $listen->{$lid}->{socket};
+ my $socket = $listen->{$lid}->{handle};
# KQueue
if (KQUEUE) { $loop->EV_SET(fileno $socket, KQUEUE_READ, KQUEUE_ADD) }
@@ -1243,13 +1305,35 @@ sub _prepare_loop {
return $self->{_loop} if $self->{_loop};
# "kqueue"
- if (KQUEUE) { $self->{_loop} = IO::KQueue->new }
+ if (KQUEUE) {
+
+ # Debug
+ warn "KQUEUE MAINLOOP\n" if DEBUG;
+
+ return $self->{_loop} = IO::KQueue->new;
+ }
# "epoll"
- elsif (EPOLL) { $self->{_loop} = IO::Epoll->new }
+ elsif (EPOLL) {
+
+ # Debug
+ warn "EPOLL MAINLOOP\n" if DEBUG;
+
+ $self->{_loop} = IO::Epoll->new;
+ }
# "poll"
- else { $self->{_loop} = IO::Poll->new }
+ else {
+
+ # Debug
+ warn "POLL MAINLOOP\n" if DEBUG;
+
+ $self->{_loop} = IO::Poll->new;
+ }
+
+ # Dummy handle to make empty poll respect the timeout and block
+ $self->{_loop}->mask(IO::Socket::INET->new(Listen => 1),
+ EPOLL ? EPOLL_POLLIN : POLLIN);
return $self->{_loop};
}
@@ -1258,7 +1342,7 @@ sub _read {
my ($self, $id) = @_;
# Listen socket (new connection)
- if (my $l = $self->{_listen}->{$id}) { $self->_accept($l->{socket}) }
+ if (my $l = $self->{_listen}->{$id}) { $self->_accept($l->{handle}) }
# Connection
my $c = $self->{_cs}->{$id};
@@ -1269,11 +1353,11 @@ sub _read {
# TLS connect
return $self->_tls_connect($id) if $c->{tls_connect};
- # Socket
- return unless defined(my $socket = $c->{socket});
+ # Handle
+ return unless defined(my $handle = $c->{handle});
# Read as much as possible
- my $read = $socket->sysread(my $buffer, 4194304, 0);
+ my $read = $handle->sysread(my $buffer, 4194304, 0);
# Error
unless (defined $read) {
@@ -1339,7 +1423,7 @@ sub _timer {
my $self = shift;
# Timers
- return unless my $ts = $self->{_ts};
+ return unless my $ts = $self->{_timer};
# Check
my $count = 0;
@@ -1370,23 +1454,21 @@ sub _tls_accept {
# Connection
my $c = $self->{_cs}->{$id};
- # Connected
- if ($c->{socket}->accept_SSL) {
- delete $c->{tls_accept};
- return;
- }
+ # Accepted
+ if ($c->{handle}->accept_SSL) {
- # Error
- my $error = $IO::Socket::SSL::SSL_ERROR;
+ # Cleanup
+ delete $c->{tls_accept};
- # Reading
- if ($error == TLS_READ) { $self->_not_writing($id) }
+ # Accept callback
+ my $cb = $c->{on_accept};
+ $self->_run_event('accept', $cb, $id) if $cb;
- # Writing
- elsif ($error == TLS_WRITE) { $self->_writing($id) }
+ return;
+ }
- # Real error
- else { $self->_error($id, $error) }
+ # Handle error
+ $self->_tls_error($id);
}
sub _tls_connect {
@@ -1396,11 +1478,25 @@ sub _tls_connect {
my $c = $self->{_cs}->{$id};
# Connected
- if ($c->{socket}->connect_SSL) {
+ if ($c->{handle}->connect_SSL) {
+
+ # Cleanup
delete $c->{tls_connect};
+
+ # Connect callback
+ my $cb = $c->{on_connect};
+ $self->_run_event('connect', $cb, $id) if $cb;
+
return;
}
+ # Handle error
+ $self->_tls_error($id);
+}
+
+sub _tls_error {
+ my ($self, $id) = @_;
+
# Error
my $error = $IO::Socket::SSL::SSL_ERROR;
@@ -1426,12 +1522,24 @@ sub _write {
# TLS connect
return $self->_tls_connect($id) if $c->{tls_connect};
- # Connect has just completed
- return if $c->{connecting};
+ # Handle
+ return unless my $handle = $c->{handle};
- # Socket
- return unless my $socket = $c->{socket};
- return unless $socket->connected;
+ # Connecting
+ if ($c->{connecting}) {
+
+ # Cleanup
+ delete $c->{connecting};
+ my $timer = delete $c->{connect_timer};
+ $self->_drop_immediately($timer) if $timer;
+
+ # Debug
+ warn "CONNECTED $id\n" if DEBUG;
+
+ # Connect callback
+ my $cb = $c->{on_connect};
+ $self->_run_event('connect', $cb, $id) if $cb && !$c->{tls};
+ }
# Callback
if ($c->{drain} && (my $event = delete $c->{drain})) {
@@ -1439,7 +1547,7 @@ sub _write {
}
# Write
- my $written = $socket->syswrite($c->{buffer});
+ my $written = $handle->syswrite($c->{buffer});
# Error
unless (defined $written) {
@@ -1473,13 +1581,13 @@ sub _writing {
# Writing
return if my $writing = $c->{writing};
- # Socket
- return unless my $socket = $c->{socket};
+ # Handle
+ return unless my $handle = $c->{handle};
# KQueue
my $loop = $self->_prepare_loop;
if (KQUEUE) {
- my $fd = fileno $socket;
+ my $fd = fileno $handle;
# Writing
$loop->EV_SET($fd, KQUEUE_READ, KQUEUE_ADD) unless defined $writing;
@@ -1490,11 +1598,11 @@ sub _writing {
else {
# Cleanup
- $loop->remove($socket);
+ $loop->remove($handle);
# Writing
my $mask = EPOLL ? EPOLL_POLLIN | EPOLL_POLLOUT : POLLIN | POLLOUT;
- $loop->mask($socket, $mask);
+ $loop->mask($handle, $mask);
}
# Writing
@@ -1506,7 +1614,7 @@ __END__
=head1 NAME
-Mojo::IOLoop - Minimalistic Reactor For Non-Blocking TCP Clients And Servers
+Mojo::IOLoop - Minimalistic Reactor For Async TCP Clients And Servers
=head1 SYNOPSIS
@@ -1561,11 +1669,11 @@ Mojo::IOLoop - Minimalistic Reactor For Non-Blocking TCP Clients And Servers
=head1 DESCRIPTION
L<Mojo::IOLoop> is a very minimalistic reactor that has been reduced to the
-absolute minimal feature set required to build solid and scalable
-non-blocking TCP clients and servers.
+absolute minimal feature set required to build solid and scalable async TCP
+clients and servers.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
-L<IO::Socket::SSL> are supported transparently and used if installed.
+Optional modules L<IO::KQueue>, L<IO::Epoll> and L<IO::Socket::SSL> are
+supported transparently and used if installed.
A TLS certificate and key are also built right in to make writing test
servers as easy as possible.
@@ -1595,8 +1703,8 @@ dropped, defaults to C<3>.
my $server = $loop->dns_server;
$loop = $loop->dns_server('8.8.8.8');
-C<DNS> server to use for non-blocking lookups, defaults to the value of
-C<MOJO_DNS_SERVER>, auto detection or C<8.8.8.8>.
+IP address of C<DNS> server to use for non-blocking lookups, defaults to the
+value of C<MOJO_DNS_SERVER>, auto detection or C<8.8.8.8>.
Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<dns_timeout>
@@ -1618,14 +1726,6 @@ Setting the value to C<0> will make this loop stop accepting new connections
and allow it to shutdown gracefully without interrupting existing
connections.
-=head2 C<on_idle>
-
- my $cb = $loop->on_idle;
- $loop = $loop->on_idle(sub {...});
-
-Callback to be invoked on every reactor tick if no events occurred.
-Note that this attribute is EXPERIMENTAL and might change without warning!
-
=head2 C<on_lock>
my $cb = $loop->on_lock;
@@ -1643,20 +1743,6 @@ Note that exceptions in this callback are not captured.
return 1;
});
-=head2 C<on_tick>
-
- my $cb = $loop->on_tick;
- $loop = $loop->on_tick(sub {...});
-
-Callback to be invoked on every reactor tick, this for example allows you to
-run multiple reactors next to each other.
-
- my $loop2 = Mojo::IOLoop->new(timeout => 0);
- Mojo::IOLoop->singleton->on_tick(sub { $loop2->one_tick });
-
-Note that the loop timeout can be changed dynamically at any time to adjust
-responsiveness.
-
=head2 C<on_unlock>
my $cb = $loop->on_unlock;
@@ -1671,7 +1757,7 @@ Note that exceptions in this callback are not captured.
$loop = $loop->timeout(5);
Maximum time in seconds our loop waits for new events to happen, defaults to
-C<0.25>.
+C<0.025>.
Note that a value of C<0> would make the loop non-blocking.
=head1 METHODS
@@ -1693,16 +1779,9 @@ possible.
address => '127.0.0.1',
port => 3000
);
- my $id = $loop->connect({
- address => '[::1]',
- port => 443,
- tls => 1
- });
-Open a TCP connection to a remote host, IPv6 will be used automatically if
-available.
-Note that IPv6 support depends on L<IO::Socket::IP> and TLS support on
-L<IO::Socket::SSL>.
+Open a TCP connection to a remote host.
+Note that TLS support depends on L<IO::Socket::SSL>.
These options are currently available.
@@ -1712,6 +1791,10 @@ These options are currently available.
Address or host name of the peer to connect to.
+=item C<handle>
+
+Use an already prepared handle.
+
=item C<on_connect>
Callback to be invoked once the connection is established.
@@ -1736,10 +1819,6 @@ Port to connect to.
Protocol to use, defaults to C<tcp>.
-=item C<socket>
-
-Use an already prepared socket handle.
-
=item C<tls>
Enable TLS.
@@ -1758,9 +1837,9 @@ dropped.
$loop = $loop->drop($id);
-Drop a connection, listen socket or timer.
+Drop anything with an id.
Connections will be dropped gracefully by allowing them to finish writing all
-data in it's write buffer.
+data in its write buffer.
=head2 C<generate_port>
@@ -1788,9 +1867,8 @@ Check if loop is running.
tls_key => '/foo/server.key'
);
-Create a new listen socket, IPv6 will be used automatically if available.
-Note that IPv6 support depends on L<IO::Socket::IP> and TLS support on
-L<IO::Socket::SSL>.
+Create a new listen socket.
+Note that TLS support depends on L<IO::Socket::SSL>.
These options are currently available.
@@ -1800,6 +1878,10 @@ These options are currently available.
Local address to listen on, defaults to all.
+=item C<backlog>
+
+Maximum backlog size, defaults to C<SOMAXCONN>.
+
=item C<file>
A unix domain socket to listen on.
@@ -1824,10 +1906,6 @@ Callback to be invoked if new data arrives on the connection.
Port to listen on.
-=item C<queue_size>
-
-Maximum queue size, defaults to C<SOMAXCONN>.
-
=item C<tls>
Enable TLS.
@@ -1888,6 +1966,13 @@ Callback to be invoked if an error event happens on the connection.
Callback to be invoked if the connection gets closed.
+=head2 C<on_idle>
+
+ my $id = $loop->on_idle(sub {...});
+
+Callback to be invoked on every reactor tick if no other events occurred.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
=head2 C<on_read>
$loop = $loop->on_read($id => sub {...});
@@ -1900,6 +1985,19 @@ Callback to be invoked if new data arrives on the connection.
# Process chunk
});
+=head2 C<on_tick>
+
+ my $id = $loop->on_tick(sub {...});
+
+Callback to be invoked on every reactor tick, this for example allows you to
+run multiple reactors next to each other.
+
+ my $loop2 = Mojo::IOLoop->new(timeout => 0);
+ Mojo::IOLoop->singleton->on_tick(sub { $loop2->one_tick });
+
+Note that the loop timeout can be changed dynamically at any time to adjust
+responsiveness.
+
=head2 C<one_tick>
$loop->one_tick;
@@ -1934,7 +2032,8 @@ The remote port.
$loop = $loop->resolve('mojolicio.us', 'A', sub {...});
-Resolve domain into C<A>, C<AAAA> or C<TXT> records.
+Resolve domain into C<A>, C<AAAA>, C<CNAME>, C<MX>, C<NS>, C<PTR> or C<TXT>
+records, C<*> will query for all at once.
Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<singleton>
@@ -5,6 +5,7 @@ use warnings;
use base 'Mojo::Base';
+use B;
use Mojo::Util;
__PACKAGE__->attr('error');
@@ -182,26 +183,6 @@ sub _decode_array {
return $self->_exception($ref, 'Missing right square bracket');
}
-sub _decode_names {
- my ($self, $ref) = @_;
-
- # Name found
- if ($$ref =~ s/$NAMES_RE//o) { return $1 }
-
- # No number
- return;
-}
-
-sub _decode_number {
- my ($self, $ref) = @_;
-
- # Number found
- if ($$ref =~ s/$NUMBER_RE//o) { return $1 }
-
- # No number
- return;
-}
-
sub _decode_object {
my ($self, $ref) = @_;
@@ -244,23 +225,6 @@ sub _decode_object {
return $self->_exception($ref, 'Missing right curly bracket');
}
-sub _decode_string {
- my ($self, $ref) = @_;
-
- # String
- if ($$ref =~ s/$STRING_RE//o) {
- my $string = $1;
-
- # Unescape
- $string =~ s/$UNESCAPE_RE/_unescape($1, $2, $3, $4)/gex;
-
- return $string;
- }
-
- # No string
- return;
-}
-
sub _decode_structure {
my ($self, $ref) = @_;
@@ -285,28 +249,29 @@ sub _decode_values {
my ($self, $ref) = @_;
# Number
- if (defined(my $number = $self->_decode_number($ref))) {
- return [$number];
- }
+ if ($$ref =~ s/$NUMBER_RE//o) { return [0 + $1] }
# String
- elsif (defined(my $string = $self->_decode_string($ref))) {
+ elsif ($$ref =~ s/$STRING_RE//o) {
+ my $string = $1;
+
+ # Unescape
+ $string =~ s/$UNESCAPE_RE/_unescape($1, $2, $3, $4)/gex;
+
return [$string];
}
# Name
- elsif (my $name = $self->_decode_names($ref)) {
+ elsif ($$ref =~ s/$NAMES_RE//o) {
# "false"
- if ($name eq 'false') { $name = $FALSE }
+ if ($1 eq 'false') { return [$FALSE] }
# "null"
- elsif ($name eq 'null') { $name = undef }
+ elsif ($1 eq 'null') { return [undef] }
# "true"
- elsif ($name eq 'true') { $name = $TRUE }
-
- return [$name];
+ elsif ($1 eq 'true') { return [$TRUE] }
}
# Object or array
@@ -376,7 +341,9 @@ sub _encode_values {
return 'true' if ref $value eq 'Mojo::JSON::_Bool' && $value;
# Number
- return $value if $value =~ m/$NUMBER_RE$/o;
+ my $flags = B::svref_2object(\$value)->FLAGS;
+ return $value
+ if $flags & (B::SVp_IOK | B::SVp_NOK) && !($flags & B::SVp_POK);
# String
return $self->_encode_string($value);
@@ -28,10 +28,20 @@ sub load {
# Shortcut
return 1 unless $module;
+ # Forced reload
+ if ($ENV{MOJO_RELOAD}) {
+
+ # Unload
+ my $key = $module;
+ $key =~ s/\:\:/\//g;
+ $key .= '.pm';
+ _unload($key);
+ }
+
# Already loaded
- return if $module->can('new');
+ else { return if $module->can('new') }
- # Try
+ # Load
eval "require $module";
# Catch
@@ -49,6 +59,13 @@ sub load {
}
sub reload {
+
+ # Force script reloading
+ delete $INC{$0};
+ $STATS->{$0} = $^T - 1;
+ $INC{$0} = $0;
+
+ # Reload
while (my ($key, $file) = each %INC) {
# Modified time
@@ -62,25 +79,18 @@ sub reload {
if ($mtime > $STATS->{$file}) {
# Debug
- warn "\n$key -> $file modified, reloading!\n" if DEBUG;
+ warn "$key -> $file modified, reloading!\n" if DEBUG;
+
+ $STATS->{$file} = $mtime;
# Unload
- delete $INC{$key};
- my @subs = grep { index($DB::sub{$_}, "$file:") == 0 }
- keys %DB::sub;
- for my $sub (@subs) {
- eval { undef &$sub };
- carp "Can't unload sub '$sub' in '$file': $@" if $@;
- delete $DB::sub{$sub};
- }
+ _unload($key);
# Try
eval { require $key };
# Catch
return Mojo::Exception->new($@) if $@;
-
- $STATS->{$file} = $mtime;
}
}
@@ -125,6 +135,22 @@ sub search {
return $modules;
}
+sub _unload {
+ my $key = shift;
+
+ # Unload
+ my $file = $INC{$key};
+ delete $INC{$key};
+ return unless $file;
+ my @subs = grep { index($DB::sub{$_}, "$file:") == 0 }
+ keys %DB::sub;
+ for my $sub (@subs) {
+ eval { undef &$sub };
+ carp "Can't unload sub '$sub' in '$file': $@" if $@;
+ delete $DB::sub{$sub};
+ }
+}
+
1;
__END__
@@ -247,8 +247,7 @@ sub _parse_env {
$self->env($env);
# Headers
- for my $name (keys %{$env}) {
- my $value = $env->{$name};
+ while (my ($name, $value) = each %$env) {
# Header
if ($name =~ s/^HTTP_//i) {
@@ -28,7 +28,6 @@ __PACKAGE__->attr(version => '1.1');
# DEPRECATED in Comet!
*finish_cb = \&on_finish;
*progress_cb = \&on_progress;
-*read_cb = \&on_read;
# I'll keep it short and sweet. Family. Religion. Friendship.
# These are the three demons you must slay if you wish to succeed in
@@ -53,28 +52,33 @@ sub body {
$self->content(Mojo::Content::Single->new)
if $self->content->isa('Mojo::Content::MultiPart');
+ # Content
+ my $content = $self->content;
+
# Get
unless (@_) {
- return $self->on_read
- ? $self->on_read
+ return $content->on_read
+ ? $content->on_read
: return $self->content->asset->slurp;
}
# New content
- my $content = shift;
+ my $new = shift;
# Cleanup
- $self->on_read(undef);
- $self->content->asset(Mojo::Asset::Memory->new);
+ $content->on_read(undef);
+ $content->asset(Mojo::Asset::Memory->new);
# Shortcut
- return $self unless defined $content;
+ return $self unless defined $new;
# Callback
- if (ref $content eq 'CODE') { $self->on_read($content) }
+ if (ref $new eq 'CODE') {
+ $content->on_read(sub { shift and $self->$new(@_) });
+ }
# Set text content
- elsif (length $content) { $self->content->asset->add_chunk($content) }
+ elsif (length $new) { $content->asset->add_chunk($new) }
return $self;
}
@@ -253,8 +257,6 @@ sub error {
return $self;
}
-sub finish { shift->content->finish(@_) }
-
sub fix_headers {
my $self = shift;
@@ -377,8 +379,6 @@ sub param {
sub parse { shift->_parse(0, @_) }
sub parse_until_body { shift->_parse(1, @_) }
-sub on_read { shift->content->on_read(@_) }
-
sub start_line_size { length shift->build_start_line }
sub to_string {
@@ -696,20 +696,6 @@ Callback called after message building or parsing is finished.
Progress callback.
-=head2 C<on_read>
-
- my $cb = $message->on_read;
- $message = $message->on_read(sub {...});
-
-Content parser callback.
-
- $message = $message->on_read(sub {
- my ($self, $chunk) = @_;
- print $chunk;
- });
-
-Note that this attribute is EXPERIMENTAL and might change without warning!
-
=head1 METHODS
L<Mojo::Message> inherits all methods from L<Mojo::Base> and implements the
@@ -771,8 +757,8 @@ Access message cookies.
my $dom = $message->dom;
my $collection = $message->dom('a[href]');
-Parses content into a L<Mojo::DOM> object and takes an optional selector to
-perform a find on it right away.
+Turns content into a L<Mojo::DOM> object and takes an optional selector to
+perform a C<find> on it right away, which returns a collection.
Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<error>
@@ -784,13 +770,6 @@ Note that this method is EXPERIMENTAL and might change without warning!
Parser errors and codes.
-=head2 C<finish>
-
- $message->finish;
-
-Finish dynamic content generation.
-Note that this method is EXPERIMENTAL and might change without warning!
-
=head2 C<fix_headers>
$message = $message->fix_headers;
@@ -23,7 +23,7 @@ sub new {
my $self = shift->SUPER::new();
# Hash/Array
- if (defined $_[1]) { $self->append(@_) }
+ if (@_ > 1) { $self->append(@_) }
# String
else { $self->parse(@_) }
@@ -214,10 +214,10 @@ sub to_string {
# *( pchar / "/" / "?" ) with the exception of ";", "&" and "="
encode $charset, $name if $charset;
- url_escape $name, $Mojo::URL::PARAM;
+ url_escape $name, $Mojo::URL::UNRESERVED;
if ($value) {
encode $charset, $value if $charset;
- url_escape $value, $Mojo::URL::PARAM;
+ url_escape $value, $Mojo::URL::UNRESERVED;
}
# Replace whitespace with "+"
@@ -306,9 +306,10 @@ Merge parameters.
=head2 C<param>
- my $foo = $params->param('foo');
- my @foo = $params->param('foo');
- my $foo = $params->param(foo => 'ba;r');
+ my @names = $params->param;
+ my $foo = $params->param('foo');
+ my @foo = $params->param('foo');
+ my $foo = $params->param(foo => 'ba;r');
Check parameter values.
@@ -134,6 +134,7 @@ L<Mojo::Server::CGI> is a simple and portable implementation of RFC 3875.
L<Mojo::Server::CGI> inherits all attributes from L<Mojo::Server> and
implements the following new ones.
+See L<Mojolicious::Guides::Cookbook> for deployment recipes.
=head2 C<nph>
@@ -21,7 +21,7 @@ use constant BONJOUR => $ENV{MOJO_NO_BONJOUR}
# Debug
use constant DEBUG => $ENV{MOJO_DAEMON_DEBUG} || 0;
-__PACKAGE__->attr([qw/group listen listen_queue_size silent user/]);
+__PACKAGE__->attr([qw/backlog group listen silent user/]);
__PACKAGE__->attr(ioloop => sub { Mojo::IOLoop->singleton });
__PACKAGE__->attr(keep_alive_timeout => 5);
__PACKAGE__->attr(max_clients => 1000);
@@ -53,8 +53,8 @@ sub prepare_ioloop {
my $loop = $self->ioloop;
# Listen
- my $listen = $self->listen || 'http://*:3000';
- $self->_listen($_) for split ',', $listen;
+ my $listen = $self->listen || ['http://*:3000'];
+ $self->_listen($_) for @$listen;
# Max clients
$loop->max_connections($self->max_clients);
@@ -166,8 +166,11 @@ sub _build_tx {
sub _drop {
my ($self, $id) = @_;
- # WebSocket
- if (my $ws = $self->{_cs}->{$id}->{websocket}) { $ws->server_close }
+ # Connection
+ my $c = $self->{_cs}->{$id};
+
+ # Transaction
+ if (my $tx = $c->{websocket} || $c->{transaction}) { $tx->server_close }
# Drop connection
delete $self->{_cs}->{$id};
@@ -251,22 +254,23 @@ sub _listen {
# Options
my $options = {};
+ my $tls;
# UNIX domain socket
if ($listen =~ /^file\:\/\/(.+)$/) { unlink $options->{file} = $1 }
# Internet socket
elsif ($listen =~ /^(http(?:s)?)\:\/\/(.+)\:(\d+)(?:\:(.*)\:(.*))?$/) {
- $options->{tls} = 1 if $1 eq 'https';
+ $tls = $options->{tls} = 1 if $1 eq 'https';
$options->{address} = $2 if $2 ne '*';
$options->{port} = $3;
$options->{tls_cert} = $4 if $4;
$options->{tls_key} = $5 if $5;
}
- # Listen queue size
- my $queue = $self->listen_queue_size;
- $options->{queue_size} = $queue if $queue;
+ # Listen backlog size
+ my $backlog = $self->backlog;
+ $options->{backlog} = $backlog if $backlog;
# Weaken
weaken $self;
@@ -276,7 +280,7 @@ sub _listen {
my ($loop, $id) = @_;
# Add new connection
- $self->{_cs}->{$id} = {tls => $options->{tls} ? 1 : 0};
+ $self->{_cs}->{$id} = {tls => $tls};
# Keep alive timeout
$loop->connection_timeout($id => $self->keep_alive_timeout);
@@ -299,7 +303,7 @@ sub _listen {
type => '_http._tcp',
domain => 'local',
port => $port
- ) if $port && !$options->{tls};
+ ) if $port && !$tls;
}
# Log
@@ -348,7 +352,7 @@ sub _upgrade {
my $c = $self->{_cs}->{$id};
# WebSocket handshake handler
- my $ws = $c->{websocket} = $self->on_websocket_handshake->($self, $tx);
+ my $ws = $c->{websocket} = $self->on_websocket->($self, $tx);
# Upgrade connection timeout
$self->ioloop->connection_timeout($id, $self->websocket_timeout);
@@ -410,24 +414,30 @@ Mojo::Server::Daemon - Async IO HTTP 1.1 And WebSocket Server
use Mojo::Server::Daemon;
my $daemon = Mojo::Server::Daemon->new;
- $daemon->listen('http://*:8080');
+ $daemon->listen(['http://*:8080']);
$daemon->run;
=head1 DESCRIPTION
L<Mojo::Server::Daemon> is a full featured async io HTTP 1.1 and WebSocket
-server with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll>, C<kqueue>, hot deployment
-and UNIX domain socket sharing support.
+server with C<TLS>, C<Bonjour>, C<epoll> and C<kqueue> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
=head1 ATTRIBUTES
L<Mojo::Server::Daemon> inherits all attributes from L<Mojo::Server> and
implements the following new ones.
+=head2 C<backlog>
+
+ my $backlog = $daemon->backlog;
+ $daemon = $daemon->backlog(128);
+
+Listen backlog size, defaults to C<SOMAXCONN>.
+
=head2 C<group>
my $group = $daemon->group;
@@ -452,16 +462,9 @@ Timeout for keep alive connections in seconds, defaults to C<5>.
=head2 C<listen>
my $listen = $daemon->listen;
- $daemon = $daemon->listen('https://localhost:3000,file:///my.sock');
-
-Ports and files to listen on, defaults to C<http://*:3000>.
-
-=head2 C<listen_queue_size>
-
- my $listen_queue_size = $daemon->listen_queue_zise;
- $daemon = $daemon->listen_queue_zise(128);
+ $daemon = $daemon->listen(['https://localhost:3000']);
-Listen queue size, defaults to C<SOMAXCONN>.
+List of ports and files to listen on, defaults to C<http://*:3000>.
=head2 C<max_clients>
@@ -422,6 +422,7 @@ Mojo::Server::FastCGI - FastCGI Server
L<Mojo::Server::FastCGI> is a portable pure-Perl FastCGI implementation as
described in the C<FastCGI Specification>.
+See L<Mojolicious::Guides::Cookbook> for deployment recipes.
=head1 ATTRIBUTES
@@ -0,0 +1,688 @@
+package Mojo::Server::Hypnotoad;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use Carp 'croak';
+use Cwd 'abs_path';
+use Fcntl ':flock';
+use File::Basename 'dirname';
+use File::Spec;
+use IO::File;
+use IO::Poll 'POLLIN';
+use List::Util 'shuffle';
+use Mojo::Server::Daemon;
+use POSIX qw/setsid WNOHANG/;
+use Scalar::Util 'weaken';
+
+use constant DEBUG => $ENV{HYPNOTOAD_DEBUG} || 0;
+
+sub DESTROY {
+ my $self = shift;
+
+ # Worker
+ return if $ENV{HYPNOTOAD_WORKER};
+
+ # Manager
+ return unless my $file = $self->{_config}->{pid_file};
+ unlink $file if -f $file;
+}
+
+# Marge? Since I'm not talking to Lisa,
+# would you please ask her to pass me the syrup?
+# Dear, please pass your father the syrup, Lisa.
+# Bart, tell Dad I will only pass the syrup if it won't be used on any meat
+# product.
+# You dunkin' your sausages in that syrup homeboy?
+# Marge, tell Bart I just want to drink a nice glass of syrup like I do every
+# morning.
+# Tell him yourself, you're ignoring Lisa, not Bart.
+# Bart, thank your mother for pointing that out.
+# Homer, you're not not-talking to me and secondly I heard what you said.
+# Lisa, tell your mother to get off my case.
+# Uhhh, dad, Lisa's the one you're not talking to.
+# Bart, go to your room.
+sub run {
+ my ($self, $app, $config) = @_;
+
+ # No windows support
+ die "Hypnotoad not available for Windows.\n" if $^O eq 'MSWin32';
+
+ # Application
+ $ENV{HYPNOTOAD_APP} ||= abs_path $app;
+
+ # Config
+ $ENV{HYPNOTOAD_CONFIG} ||= abs_path $config;
+
+ # Production
+ $ENV{MOJO_MODE} ||= 'production';
+
+ # Executable
+ $ENV{HYPNOTOAD_EXE} ||= $0;
+ $0 = $ENV{HYPNOTOAD_APP};
+
+ # Cleanup
+ delete $ENV{MOJO_COMMANDS_DONE};
+ delete $ENV{MOJO_RELOAD};
+
+ # Clean start
+ exec $ENV{HYPNOTOAD_EXE} unless $ENV{HYPNOTOAD_REV}++;
+
+ # Daemon
+ my $daemon = $self->{_daemon} = Mojo::Server::Daemon->new;
+
+ # Debug
+ warn "APPLICATION $ENV{HYPNOTOAD_APP}\n" if DEBUG;
+
+ # Preload application
+ my $file = $ENV{HYPNOTOAD_APP};
+ my $preload;
+ unless ($preload = do $file) {
+ die qq/Can't load application "$file": $@/ if $@;
+ die qq/Can't load application "$file": $!/ unless defined $preload;
+ die qq/Can't load application' "$file".\n/ unless $preload;
+ }
+ $daemon->app($preload);
+
+ # Load configuration
+ $self->_config;
+
+ # Testing
+ die "Everything looks good!\n" if $ENV{HYPNOTOAD_TEST};
+
+ # Prepare loop
+ $daemon->prepare_ioloop;
+
+ # Pipe for worker communication
+ pipe($self->{_reader}, $self->{_writer})
+ or croak "Can't create pipe: $!";
+ $self->{_poll} = IO::Poll->new;
+ $self->{_poll}->mask($self->{_reader}, POLLIN);
+
+ # Daemonize
+ if (!DEBUG && !$ENV{HYPNOTOAD_FOREGROUND}) {
+
+ # Fork and kill parent
+ die "Can't fork: $!" unless defined(my $pid = fork);
+ exit 0 if $pid;
+ setsid or die "Can't start a new session: $!";
+
+ # Close file handles
+ open STDIN, '</dev/null';
+ open STDOUT, '>/dev/null';
+ open STDERR, '>&STDOUT';
+ }
+
+ # Config
+ my $c = $self->{_config};
+
+ # Manager signals
+ $SIG{INT} = $SIG{TERM} = sub { $self->{_done} = 1 };
+ $SIG{CHLD} = sub {
+ while ((my $pid = waitpid -1, WNOHANG) > 0) { $self->_reap($pid) }
+ };
+ $SIG{QUIT} = sub { $self->{_done} = $self->{_graceful} = 1 };
+ $SIG{USR2} = sub { $self->{_upgrade} ||= time };
+ $SIG{TTIN} = sub { $c->{workers}++ };
+ $SIG{TTOU} = sub {
+ return unless $c->{workers};
+ $c->{workers}--;
+ $self->{_workers}->{shuffle keys %{$self->{_workers}}}->{graceful}
+ ||= time;
+ };
+
+ # Debug
+ warn "MANAGER STARTED $$\n" if DEBUG;
+
+ # Mainloop
+ $self->_manage while 1;
+}
+
+sub _config {
+ my $self = shift;
+
+ # File
+ my $file = $ENV{HYPNOTOAD_CONFIG};
+
+ # Debug
+ warn "CONFIG $file\n" if DEBUG;
+
+ # Config
+ my $c = {};
+ if (-r $file) {
+ unless ($c = do $file) {
+ die qq/Can't load config file "$file": $@/ if $@;
+ die qq/Can't load config file "$file": $!/ unless defined $c;
+ die qq/Config file "$file" did not return a hashref.\n/
+ unless ref $c eq 'HASH';
+ }
+ }
+ $self->{_config} = $c;
+
+ # Graceful timeout
+ $c->{graceful_timeout} ||= 30;
+
+ # Heartbeat interval
+ $c->{heartbeat_interval} ||= 5;
+
+ # Heartbeat timeout
+ $c->{heartbeat_timeout} ||= 2;
+
+ # Lock file
+ $c->{lock_file}
+ ||= File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
+ "hypnotoad.$$.lock");
+
+ # PID file
+ $c->{pid_file}
+ ||= File::Spec->catfile(dirname($ENV{HYPNOTOAD_APP}), 'hypnotoad.pid');
+
+ # Reverse proxy support
+ $ENV{MOJO_REVERSE_PROXY} = 1 if $c->{proxy};
+
+ # Upgrade timeout
+ $c->{upgrade_timeout} ||= 30;
+
+ # Workers
+ $c->{workers} ||= 4;
+
+ # Daemon
+ my $daemon = $self->{_daemon};
+
+ # Backlog
+ $daemon->backlog($c->{backlog}) if defined $c->{backlog};
+
+ # Clients
+ $daemon->max_clients($c->{clients} || 1000);
+
+ # Group
+ $daemon->group($c->{group}) if $c->{group};
+
+ # Keep alive requests
+ $daemon->max_requests($c->{keep_alive_requests} || 100);
+
+ # Keep alive timeout
+ $daemon->keep_alive_timeout($c->{keep_alive_timeout} || 5);
+
+ # Listen
+ my $listen = $c->{listen} || ['http://*:8080'];
+ $listen = [$listen] unless ref $listen;
+ $daemon->listen($listen);
+
+ # User
+ $daemon->group($c->{user}) if $c->{user};
+
+ # WebSocket timeout
+ $daemon->websocket_timeout($c->{websocket_timeout} || 300);
+}
+
+sub _heartbeat {
+ my $self = shift;
+
+ # Poll
+ my $poll = $self->{_poll};
+ $poll->poll(1);
+
+ # Readable
+ return unless $poll->handles(POLLIN);
+
+ # Read
+ return unless $self->{_reader}->sysread(my $chunk, 4194304);
+
+ # Parse
+ while ($chunk =~ /(\d+)\n/g) {
+ my $pid = $1;
+
+ # Heartbeat
+ $self->{_workers}->{$pid}->{time} = time;
+ }
+}
+
+sub _manage {
+ my $self = shift;
+
+ # Config
+ my $c = $self->{_config};
+
+ # Housekeeping
+ if (!$self->{_done}) {
+
+ # Spawn more workers
+ $self->_spawn while keys %{$self->{_workers}} < $c->{workers};
+
+ # Check PID file
+ $self->_pid;
+ }
+
+ # Shutdown
+ elsif (!keys %{$self->{_workers}}) { exit 0 }
+
+ # Upgraded
+ if ($ENV{HYPNOTOAD_PID} && $ENV{HYPNOTOAD_PID} ne $$) {
+
+ # Debug
+ warn "STOPPING MANAGER $ENV{HYPNOTOAD_PID}\n" if DEBUG;
+
+ kill 'QUIT', $ENV{HYPNOTOAD_PID};
+ }
+ $ENV{HYPNOTOAD_PID} = $$;
+
+ # Check heartbeat
+ $self->_heartbeat;
+
+ # Upgrade
+ if ($self->{_upgrade} && !$self->{_done}) {
+
+ # Start
+ unless ($self->{_new}) {
+
+ # Debug
+ warn "UPGRADING\n" if DEBUG;
+
+ # Fork
+ croak "Can't fork: $!" unless defined(my $pid = fork);
+ $self->{_new} = $pid if $pid;
+
+ # Fresh start
+ exec $ENV{HYPNOTOAD_EXE} unless $pid;
+ }
+
+ # Timeout
+ kill 'TERM', $self->{_new}
+ if $self->{_upgrade} + $c->{upgrade_timeout} <= time;
+ }
+
+ # Workers
+ while (my ($pid, $w) = each %{$self->{_workers}}) {
+
+ # No heartbeat
+ my $interval = $c->{heartbeat_interval};
+ my $timeout = $c->{heartbeat_timeout};
+ if ($w->{time} + $interval + $timeout <= time) {
+
+ # Debug
+ warn "STOPPING WORKER $pid\n" if DEBUG;
+
+ # Try graceful
+ $w->{graceful} ||= time;
+ }
+
+ # Graceful stop
+ $w->{graceful} ||= time if $self->{_graceful};
+ if ($w->{graceful}) {
+
+ # Debug
+ warn "QUIT $pid\n" if DEBUG;
+
+ # Kill
+ kill 'QUIT', $pid;
+
+ # Timeout
+ $w->{force} = 1
+ if $w->{graceful} + $c->{graceful_timeout} <= time;
+ }
+
+ # Normal stop
+ if (($self->{_done} && !$self->{_graceful}) || $w->{force}) {
+
+ # Debug
+ warn "TERM $pid\n" if DEBUG;
+
+ # Kill
+ kill 'TERM', $pid;
+ }
+ }
+}
+
+sub _pid {
+ my $self = shift;
+
+ # PID file
+ my $file = $self->{_config}->{pid_file};
+
+ # Check
+ return if -e $file;
+
+ # Debug
+ warn "PID $file\n" if DEBUG;
+
+ # Create
+ my $pid = IO::File->new($file, O_WRONLY | O_CREAT | O_EXCL, 0644)
+ or croak qq/Can't create PID file "$file": $!/;
+ print $pid $$;
+}
+
+# Dear Mr. President, there are too many states nowadays.
+# Please eliminate three.
+# P.S. I am not a crackpot.
+sub _reap {
+ my ($self, $pid) = @_;
+
+ # Cleanup failed upgrade
+ if (($self->{_new} || '') eq $pid) {
+
+ # Debug
+ warn "UPGRADE FAILED\n" if DEBUG;
+
+ delete $self->{_upgrade};
+ delete $self->{_new};
+ }
+
+ # Cleanup worker
+ else {
+
+ # Debug
+ warn "WORKER DIED $pid\n" if DEBUG;
+
+ delete $self->{_workers}->{$pid};
+ }
+}
+
+sub _spawn {
+ my $self = shift;
+
+ # Fork
+ croak "Can't fork: $!" unless defined(my $pid = fork);
+
+ # Manager
+ return $self->{_workers}->{$pid} = {time => time} if $pid;
+
+ # Worker
+ $ENV{HYPNOTOAD_WORKER} = 1;
+
+ # Daemon
+ my $daemon = $self->{_daemon};
+
+ # Loop
+ my $loop = $daemon->ioloop;
+
+ # Config
+ my $c = $self->{_config};
+
+ # Lock file
+ my $file = $c->{lock_file};
+ my $lock = IO::File->new("> $file")
+ or croak qq/Can't open lock file "$file": $!/;
+
+ # Weaken
+ weaken $self;
+
+ # Accept mutex
+ $loop->on_lock(
+ sub {
+
+ # Blocking
+ my $l;
+ if (my $blocking = $_[1]) {
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" };
+ my $old = alarm 1;
+ $l = flock $lock, LOCK_EX;
+ alarm $old;
+ };
+ if ($@) {
+ die $@ unless $@ eq "alarm\n";
+ $l = 0;
+ }
+ }
+
+ # Non blocking
+ else { $l = flock $lock, LOCK_EX | LOCK_NB }
+
+ return $l;
+ }
+ );
+ $loop->on_unlock(sub { flock $lock, LOCK_UN });
+
+ # Heartbeat
+ my $cb;
+ $cb = sub {
+ my $loop = shift;
+ $loop->timer($c->{heartbeat} => $cb);
+ $self->{_writer}->syswrite("$$\n") or exit 0;
+ };
+ $cb->($loop);
+ weaken $cb;
+
+ # Worker signals
+ $SIG{INT} = $SIG{TERM} = $SIG{CHLD} = $SIG{USR2} = $SIG{TTIN} =
+ $SIG{TTOU} = 'DEFAULT';
+ $SIG{QUIT} = sub { $loop->max_connections(0) };
+
+ # Debug
+ warn "WORKER STARTED $$\n" if DEBUG;
+
+ # Cleanup
+ delete $self->{_reader};
+ delete $self->{_poll};
+
+ # User and group
+ $daemon->setuidgid;
+
+ # Start
+ $loop->start;
+
+ # Shutdown
+ exit 0;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::Server::Hypnotoad - ALL GLORY TO THE HYPNOTOAD!
+
+=head1 SYNOPSIS
+
+ use Mojo::Server::Hypnotoad;
+
+ my $toad = Mojo::Server::Hypnotoad->new;
+ $toad->run('myapp.pl', 'hypnotoad.conf');
+
+=head1 DESCRIPTION
+
+L<Mojo::Server::Hypnotoad> is a full featured UNIX optimized preforking async
+io HTTP 1.1 and WebSocket server built around the very well tested and
+reliable L<Mojo::Server::Daemon> with C<TLS>, C<Bonjour>, C<epoll>, C<kqueue>
+and hot deployment support that just works.
+
+Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
+
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 SIGNALS
+
+You can control C<hypnotoad> at runtime with signals.
+
+=head2 Manager
+
+=over 4
+
+=item C<INT>, C<TERM>
+
+Shutdown server immediately.
+
+=item C<QUIT>
+
+Shutdown server gracefully.
+
+=item C<TTIN>
+
+Increase worker pool by one.
+
+=item C<TTOU>
+
+Decrease worker pool by one.
+
+=item C<USR2>
+
+Attempt zero downtime software upgrade (hot deployment) without losing any
+incoming connections.
+
+ Manager (old)
+ |- Worker [1]
+ |- Worker [2]
+ |- Worker [3]
+ |- Worker [4]
+ `- Manager
+ |- Worker [1]
+ |- Worker [2]
+ |- Worker [3]
+ `- Worker [4]
+
+The new manager will automatically send a C<QUIT> signal to the old manager
+and take over serving requests after starting up successfully.
+
+=back
+
+=head2 Worker
+
+=over 4
+
+=item C<INT>, C<TERM>
+
+Stop worker immediately.
+
+=item C<QUIT>
+
+Stop worker gracefully.
+
+=back
+
+=head1 CONFIGURATION
+
+C<Hypnotoad> configuration files are normal Perl scripts returning a hash.
+
+ # hypnotoad.conf
+ {listen => ['http://*:3000', 'http://*:4000'], workers => 10};
+
+The following parameters are currently available.
+
+=over 4
+
+=item backlog
+
+ backlog => 128
+
+Listen backlog size, defaults to C<SOMAXCONN>.
+
+=item clients
+
+ clients => 100
+
+Maximum number of parallel client connections per worker process, defaults to
+C<1000>.
+
+=item graceful_timeout
+
+ graceful_timeout => 15
+
+Time in seconds a graceful worker stop may take before being forced, defaults
+to C<30>.
+
+=item group
+
+ group => 'staff'
+
+Group name for worker processes.
+
+=item heartbeat_interval
+
+ heartbeat_interval => 3
+
+Heartbeat interval in seconds, defaults to C<5>.
+
+=item heartbeat_timeout
+
+ heartbeat_timeout => 5
+
+Time in seconds before a worker without a heartbeat will be stopped, defaults
+to C<2>.
+
+=item keep_alive_requests
+
+ keep_alive_requests => 50
+
+Number of keep alive requests per connection, defaults to C<100>.
+
+=item keep_alive_timeout
+
+ keep_alive_timeout => 10
+
+Time in seconds a connection may be idle, defaults to C<5>.
+
+=item listen
+
+ listen => ['http://*:80']
+
+List of ports and files to listen on, defaults to C<http://*:8080>.
+
+=item lock_file
+
+ lock_file => '/tmp/hypnotoad.lock'
+
+Full path to accept mutex lock file, defaults to a random temporary file.
+
+=item pid_file
+
+ pid_file => '/var/run/hypnotoad.pid'
+
+Full path to PID file, defaults to C<hypnotoad.pid> in the same directory as
+the application.
+
+=item proxy
+
+ proxy => 1
+
+Activate reverse proxy support, defaults to the value of
+C<MOJO_REVERSE_PROXY>.
+
+=item upgrade_timeout
+
+ upgrade_timeout => 15
+
+Time in seconds a zero downtime software upgrade may take before being
+aborted, defaults to C<30>.
+
+=item user
+
+ user => 'sri'
+
+User name for worker processes.
+
+=item websocket_timeout
+
+ websocket_timeout => 150
+
+Time in seconds a WebSocket connection may be idle, defaults to C<300>.
+
+=item workers
+
+ workers => 10
+
+Number of worker processes, defaults to C<4>.
+A good rule of thumb is two worker processes per cpu core.
+
+=back
+
+=head1 METHODS
+
+L<Mojo::Server::Hypnotoad> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 C<run>
+
+ $toad->run('script/myapp', 'hypnotoad.conf');
+
+Start server.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -113,6 +113,7 @@ Mojo::Server::PSGI - PSGI Server
L<Mojo::Server::PSGI> allows L<Mojo> applications to run on all PSGI
compatible servers.
+See L<Mojolicious::Guides::Cookbook> for deployment recipes.
=head1 METHODS
@@ -61,19 +61,18 @@ __PACKAGE__->attr(
}
);
__PACKAGE__->attr(
- on_websocket_handshake => sub {
+ on_websocket => sub {
sub {
my $self = shift;
- return $self->app->on_websocket_handshake->($self->app, @_);
+ return $self->app->on_websocket->($self->app, @_);
}
}
);
__PACKAGE__->attr(reload => sub { $ENV{MOJO_RELOAD} || 0 });
# DEPRECATED in Comet!
-*build_tx_cb = \&on_build_tx;
-*handler_cb = \&on_handler;
-*websocket_handshake_cb = \&on_websocket_handshake;
+*build_tx_cb = \&on_build_tx;
+*handler_cb = \&on_handler;
# Are you saying you're never going to eat any animal again? What about bacon?
# No.
@@ -147,10 +146,10 @@ Transaction builder callback.
Handler callback.
-=head2 C<on_websocket_handshake>
+=head2 C<on_websocket>
- my $handshake = $server->on_websocket_handshake;
- $server = $server->on_websocket_handshake(sub {
+ my $handshake = $server->on_websocket;
+ $server = $server->on_websocket(sub {
my ($self, $tx) = @_;
});
@@ -35,7 +35,7 @@ sub client_read {
$self->{_state} = 'done' if $read == 0;
# HEAD response
- if ($req->method eq 'HEAD') {
+ if ($req->method =~ /^head$/i) {
$res->parse_until_body($chunk);
$self->{_state} = 'done' if $res->content->is_parsing_body;
}
@@ -338,7 +338,7 @@ sub server_write {
if ($self->{_write} <= 0) {
# HEAD request
- if ($req->method eq 'HEAD') {
+ if ($req->method =~ /^head$/i) {
# Don't send body if request method is HEAD
$self->{_state} = 'done';
@@ -19,12 +19,10 @@ our $UNRESERVED = 'A-Za-z0-9\-\.\_\~';
our $SUBDELIM = '!\$\&\'\(\)\*\+\,\;\=';
our $PCHAR = "$UNRESERVED$SUBDELIM\%\:\@";
-# The specs for this are blurry, it's mostly a collection of w3c suggestions
-our $PARAM = "$UNRESERVED\!\$\'\(\)\*\,\:\@\/\?";
-
# IPv4 regex (RFC 3986)
my $DEC_OCTET_RE = qr/(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])/;
-our $IPV4_RE = qr/$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE/;
+our $IPV4_RE =
+ qr/^$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE$/;
# IPv6 regex (RFC 3986)
my $H16_RE = qr/[0-9A-Fa-f]{1,4}/;
@@ -882,6 +882,7 @@ Unquote string in-place.
=head2 C<url_escape>
url_escape $string;
+ url_escape $string, 'A-Za-z0-9\-\.\_\~';
URL escape in-place.
@@ -7,7 +7,6 @@ use base 'Mojo::Base';
use Carp 'croak';
use Mojo::Client;
-use Mojo::Commands;
use Mojo::Home;
use Mojo::Log;
use Mojo::Transaction::HTTP;
@@ -22,7 +21,7 @@ __PACKAGE__->attr(
}
);
__PACKAGE__->attr(
- on_websocket_handshake => sub {
+ on_websocket => sub {
sub {
return Mojo::Transaction::WebSocket->new(handshake => pop)
->server_handshake;
@@ -31,8 +30,7 @@ __PACKAGE__->attr(
);
# DEPRECATED in Comet!
-*build_tx_cb = \&on_build_tx;
-*websocket_handshake_cb = \&on_websocket_handshake;
+*build_tx_cb = \&on_build_tx;
# Oh, so they have internet on computers now!
sub new {
@@ -53,20 +51,6 @@ sub new {
sub handler { croak 'Method "handler" not implemented in subclass' }
-# Start command system
-sub start {
- my $class = shift;
-
- # We can be called on class or instance
- $class = ref $class || $class;
-
- # We are the application
- $ENV{MOJO_APP} ||= $class;
-
- # Start!
- return Mojo::Commands->start(@_);
-}
-
1;
__END__
@@ -91,6 +75,8 @@ Mojo - The Box!
$tx->res->code(200);
$tx->res->headers->content_type('text/plain');
$tx->res->body("$method request for $path!");
+
+ # Resume transaction
$tx->resume;
}
@@ -137,10 +123,10 @@ The logging layer of your application, by default a L<Mojo::Log> object.
The transaction builder callback, by default it builds a
L<Mojo::Transaction::HTTP> object.
-=head2 C<on_websocket_handshake>
+=head2 C<on_websocket>
- my $cb = $app->on_websocket_handshake;
- $app = $app->on_websocket_handshake(sub { ... });
+ my $cb = $app->on_websocket;
+ $app = $app->on_websocket(sub { ... });
The websocket handshake callback, by default it builds a
L<Mojo::Transaction::WebSocket> object and handles the response for the
@@ -171,13 +157,6 @@ or L<Mojo::Transaction::WebSocket> object.
my ($self, $tx) = @_;
}
-=head2 C<start>
-
- Mojo->start;
- Mojo->start('daemon');
-
-Start the L<Mojo::Commands> command line interface for your application.
-
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -1,144 +0,0 @@
-package MojoX::Controller;
-
-use strict;
-use warnings;
-
-# Scalpel... blood bucket... priest.
-use base 'Mojo::Base';
-
-__PACKAGE__->attr('app');
-
-# Reserved stash values
-my $STASH_RE = qr/
- ^
- (?:
- action
- |
- app
- |
- cb
- |
- class
- |
- controller
- |
- data
- |
- exception
- |
- extends
- |
- format
- |
- handler
- |
- json
- |
- layout
- |
- method
- |
- namespace
- |
- partial
- |
- path
- |
- status
- |
- template
- |
- text
- )
- $
- /x;
-
-# I'm immortal.
-# How come you scream so much when you're in danger?
-# I never said I wasn't a drama queen.
-sub render_exception { }
-sub render_not_found { }
-
-# All this knowledge is giving me a raging brainer.
-sub stash {
- my $self = shift;
-
- # Initialize
- $self->{stash} ||= {};
-
- # Hash
- return $self->{stash} unless @_;
-
- # Get
- return $self->{stash}->{$_[0]} unless @_ > 1 || ref $_[0];
-
- # Set
- my $values = ref $_[0] ? $_[0] : {@_};
- for my $key (keys %$values) {
- $self->app->log->debug(qq/Careful, "$key" is a reserved stash value./)
- if $key =~ $STASH_RE;
- $self->{stash}->{$key} = $values->{$key};
- }
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Controller - Controller Base Class
-
-=head1 SYNOPSIS
-
- use base 'MojoX::Controller';
-
-=head1 DESCRIPTION
-
-L<MojoX::Controller> is an abstract controllers base class.
-
-=head1 L<MojoX::Controller> implements the following attributes.
-
-=head2 C<app>
-
- my $app = $c->app;
- $c = $c->app(MojoSubclass->new);
-
-A reference back to the application that dispatched to this controller.
-
-=head1 METHODS
-
-L<MojoX::Controller> inherits all methods from L<Mojo::Base> and implements
-the following new ones.
-
-=head2 C<render_exception>
-
- $c->render_exception($e);
-
-Turn exception into output.
-
-=head2 C<render_not_found>
-
- $c->render_not_found;
-
-Default output.
-
-=head2 C<stash>
-
- my $stash = $c->stash;
- my $foo = $c->stash('foo');
- $c = $c->stash({foo => 'bar'});
- $c = $c->stash(foo => 'bar');
-
-Non persistent data storage and exchange.
-
- $c->stash->{foo} = 'bar';
- my $foo = $c->stash->{foo};
- delete $c->stash->{foo};
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,66 +0,0 @@
-package MojoX::Dispatcher::Routes::Controller;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Session::Cookie::Controller';
-
-__PACKAGE__->attr('match');
-
-# Just make a simple cake. And this time, if someone's going to jump out of
-# it make sure to put them in *after* you cook it.
-sub param {
- my ($self, $name) = @_;
-
- # Captures
- my $p = $self->stash->{'mojo.captures'} || {};
- return $p->{$name} if exists $p->{$name};
-
- # Params
- return $self->req->param($name);
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Dispatcher::Routes::Controller - Controller Base Class
-
-=head1 SYNOPSIS
-
- use base 'MojoX::Dispatcher::Routes::Controller';
-
-=head1 DESCRIPTION
-
-L<MojoX::Dispatcher::Routes::Controller> is a controller base class.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Dispatcher::Routes::Controller> inherits all attributes from
-L<MojoX::Session::Cookie::Controller> implements the following attributes.
-
-=head2 C<match>
-
- my $m = $c->match;
-
-A L<MojoX::Routes::Match> object containing the routes results for the
-current request.
-
-=head1 METHODS
-
-L<MojoX::Dispatcher::Routes::Controller> inherits all methods from
-L<MojoX::Session::Cookie::Controller> and implements the following new ones.
-
-=head2 C<param>
-
- my $param = $c->param('foo');
- my @params = $c->param('foo');
-
-Request parameters and routes captures.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,422 +0,0 @@
-package MojoX::Dispatcher::Routes;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Routes';
-
-use Mojo::Exception;
-use Mojo::Loader;
-use Mojo::Util 'camelize';
-use MojoX::Routes::Match;
-use Scalar::Util 'weaken';
-
-__PACKAGE__->attr(
- controller_base_class => 'MojoX::Dispatcher::Routes::Controller');
-__PACKAGE__->attr(hidden => sub { [qw/new app attr render req res stash tx/] }
-);
-__PACKAGE__->attr('namespace');
-
-# Hey. What kind of party is this? There's no booze and only one hooker.
-sub auto_render {
- my ($self, $c) = @_;
-
- # Transaction
- my $tx = $c->tx;
-
- # Rendering
- my $success = eval {
-
- # Render
- $c->render unless $c->stash->{'mojo.rendered'} || $tx->is_websocket;
-
- # Success
- 1;
- };
-
- # Renderer error
- $c->render_exception($@) if !$success && $@;
-
- # Rendered
- return;
-}
-
-sub detour {
- my $self = shift;
-
- # Partial
- $self->partial('path');
-
- # Defaults
- $self->to(@_);
-
- return $self;
-}
-
-sub dispatch {
- my ($self, $c) = @_;
-
- # Response
- my $res = $c->res;
-
- # Already rendered
- return if $res->code;
-
- # Path
- my $path = $c->stash->{path};
- $path = "/$path" if defined $path && $path !~ /^\//;
-
- # Match
- my $m = MojoX::Routes::Match->new($c, $path);
- $m->match($self);
- $c->match($m);
-
- # No match
- return 1 unless $m && @{$m->stack};
-
- # Status
- unless ($res->code) {
-
- # Websocket handshake
- $res->code(101) if !$res->code && $c->tx->is_websocket;
-
- # Error or 200
- my ($error, $code) = $c->req->error;
- $res->code($code) if $code;
- }
-
- # Walk the stack
- return 1 if $self->_walk_stack($c);
-
- # Render
- return $self->auto_render($c);
-}
-
-sub hide { push @{shift->hidden}, @_ }
-
-sub _dispatch_callback {
- my ($self, $c, $staging) = @_;
-
- # Debug
- $c->app->log->debug(qq/Dispatching callback./);
-
- # Dispatch
- my $continue;
- my $cb = $c->match->captures->{cb};
- my $success = eval {
-
- # Callback
- $continue = $cb->($c);
-
- # Success
- 1;
- };
-
- # Callback error
- if (!$success && $@) {
- my $e = Mojo::Exception->new($@);
- $c->app->log->error($e);
- return $e;
- }
-
- # Success!
- return 1 unless $staging;
- return 1 if $continue;
-
- return;
-}
-
-sub _dispatch_controller {
- my ($self, $c, $staging) = @_;
-
- # Application
- my $app = $c->match->captures->{app};
-
- # Class
- $app ||= $self->_generate_class($c);
- return 1 unless $app;
-
- # Method
- my $method = $self->_generate_method($c);
-
- # Debug
- my $dispatch = ref $app || $app;
- $dispatch .= "->$method" if $method;
- $c->app->log->debug("Dispatching $dispatch.");
-
- # Load class
- unless (ref $app && $self->{_loaded}->{$app}) {
-
- # Load
- if (my $e = Mojo::Loader->load($app)) {
-
- # Doesn't exist
- unless (ref $e) {
- $c->app->log->debug("$app does not exist, maybe a typo?");
- return;
- }
-
- # Error
- $c->app->log->error($e);
- return $e;
- }
-
- # Loaded
- $self->{_loaded}->{$app}++;
- }
-
- # Dispatch
- my $continue;
- my $success = eval {
-
- # Instantiate
- $app = $app->new($c) unless ref $app;
-
- # Action
- if ($method && $app->isa($self->controller_base_class)) {
-
- # Call action
- $continue = $app->$method if $app->can($method);
-
- # Merge stash
- my $new = $app->stash;
- @{$c->stash}{keys %$new} = values %$new;
- }
-
- # Handler
- elsif ($app->isa('Mojo')) {
-
- # Connect routes
- if ($app->can('routes')) {
- my $r = $app->routes;
- unless ($r->parent) {
- $r->parent($c->match->endpoint);
- weaken $r->{parent};
- }
- }
-
- # Handler
- $app->handler($c);
- }
-
- # Success
- 1;
- };
-
- # Controller error
- if (!$success && $@) {
- my $e = Mojo::Exception->new($@);
- $c->app->log->error($e);
- return $e;
- }
-
- # Success!
- return 1 unless $staging;
- return 1 if $continue;
-
- return;
-}
-
-sub _generate_class {
- my ($self, $c) = @_;
-
- # Field
- my $field = $c->match->captures;
-
- # Class
- my $class = $field->{class};
- my $controller = $field->{controller} || '';
- unless ($class) {
- $class = $controller;
- camelize $class;
- }
-
- # Namespace
- my $namespace = $field->{namespace};
- $namespace = $self->namespace unless defined $namespace;
- $class = length $class ? "${namespace}::$class" : $namespace
- if length $namespace;
-
- # Invalid
- return unless $class =~ /^[a-zA-Z0-9_:]+$/;
-
- return $class;
-}
-
-sub _generate_method {
- my ($self, $c) = @_;
-
- # Field
- my $field = $c->match->captures;
-
- # Prepare hidden
- unless ($self->{_hidden}) {
- $self->{_hidden} = {};
- $self->{_hidden}->{$_}++ for @{$self->hidden};
- }
-
- my $method = $field->{method};
- $method ||= $field->{action};
-
- # Shortcut
- return unless $method;
-
- # Shortcut for hidden methods
- if ($self->{_hidden}->{$method} || index($method, '_') == 0) {
- $c->app->log->debug(qq/Action "$method" is not allowed./);
- return;
- }
-
- # Invalid
- unless ($method =~ /^[a-zA-Z0-9_:]+$/) {
- $c->app->log->debug(qq/Action "$method" is invalid./);
- return;
- }
-
- return $method;
-}
-
-sub _walk_stack {
- my ($self, $c) = @_;
-
- # Stack
- my $stack = $c->match->stack;
-
- # Walk the stack
- my $staging = @$stack;
- for my $field (@$stack) {
- $staging--;
-
- # Stash
- my $stash = $c->stash;
-
- # Captures
- my $captures = $stash->{'mojo.captures'} ||= {};
- $stash->{'mojo.captures'} = {%$captures, %$field};
-
- # Merge in captures
- @{$c->stash}{keys %$field} = values %$field;
-
- # Captures
- $c->match->captures($field);
-
- # Dispatch
- my $e =
- $field->{cb}
- ? $self->_dispatch_callback($c, $staging)
- : $self->_dispatch_controller($c, $staging);
-
- # Exception
- if (ref $e) {
- $c->render_exception($e);
- return 1;
- }
-
- # Break the chain
- return 1 if $staging && !$e;
- }
-
- # Done
- return;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Dispatcher::Routes - Routes Dispatcher
-
-=head1 SYNOPSIS
-
- use MojoX::Dispatcher::Routes;
-
- # New dispatcher
- my $dispatcher = MojoX::Dispatcher::Routes->new;
-
- # Dispatch
- $dispatcher->dispatch(MojoX::Dispatcher::Routes::Controller->new);
-
-=head1 DESCRIPTION
-
-L<MojoX::Dispatcher::Routes> is a L<MojoX::Routes> based dispatcher.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Dispatcher::Routes> inherits all attributes from L<MojoX::Routes>
-and implements the following ones.
-
-=head2 C<controller_base_class>
-
- my $base = $dispatcher->controller_base_class;
- $dispatcher = $dispatcher->controller_base_class(
- 'MojoX::Dispatcher::Routes::Controller'
- );
-
-Base class used to identify controllers, defaults to
-L<MojoX::Dispatcher::Routes::Controller>.
-
-=head2 C<hidden>
-
- my $hidden = $dispatcher->hidden;
- $dispatcher = $dispatcher->hidden(
- [qw/new attr tx render req res stash/]
- );
-
-Methods and attributes that are hidden from the dispatcher.
-
-=head2 C<namespace>
-
- my $namespace = $dispatcher->namespace;
- $dispatcher = $dispatcher->namespace('Foo::Bar::Controller');
-
-Namespace to search for controllers.
-
-=head1 METHODS
-
-L<MojoX::Dispatcher::Routes> inherits all methods from L<MojoX::Routes> and
-implements the following ones.
-
-=head2 C<auto_render>
-
- $dispatcher->auto_render(MojoX::Dispatcher::Routes::Controller->new);
-
-Automatic rendering.
-
-=head2 C<detour>
-
- $dispatcher = $dispatcher->detour(action => 'foo');
- $dispatcher = $dispatcher->detour({action => 'foo'});
- $dispatcher = $dispatcher->detour('controller#action');
- $dispatcher = $dispatcher->detour('controller#action', foo => 'bar');
- $dispatcher = $dispatcher->detour('controller#action', {foo => 'bar'});
- $dispatcher = $dispatcher->detour($app);
- $dispatcher = $dispatcher->detour($app, foo => 'bar');
- $dispatcher = $dispatcher->detour($app, {foo => 'bar'});
- $dispatcher = $dispatcher->detour('MyApp');
- $dispatcher = $dispatcher->detour('MyApp', foo => 'bar');
- $dispatcher = $dispatcher->detour('MyApp', {foo => 'bar'});
-
-Set default parameters for this route and allow partial matching to simplify
-application embedding.
-Note that this method is EXPERIMENTAL and might change without warning!
-
-=head2 C<dispatch>
-
- my $e = $dispatcher->dispatch(
- MojoX::Dispatcher::Routes::Controller->new
- );
-
-Match routes and dispatch.
-
-=head2 C<hide>
-
- $dispatcher = $dispatcher->hide('new');
-
-Hide method or attribute from the dispatcher.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,361 +0,0 @@
-package MojoX::Dispatcher::Static;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use File::stat;
-use File::Spec;
-use Mojo::Asset::File;
-use Mojo::Asset::Memory;
-use Mojo::Command;
-use Mojo::Content::Single;
-use Mojo::Path;
-use MojoX::Types;
-
-__PACKAGE__->attr([qw/default_static_class prefix root/]);
-__PACKAGE__->attr(types => sub { MojoX::Types->new });
-
-# Valentine's Day's coming? Aw crap! I forgot to get a girlfriend again!
-sub dispatch {
- my ($self, $c) = @_;
-
- # Already rendered
- return if $c->res->code;
-
- # Canonical path
- my $path = $c->req->url->path->clone->canonicalize->to_string;
-
- # Prefix
- if (my $prefix = $self->prefix) {
- return 1 unless $path =~ s/^$prefix//;
- }
-
- # Parts
- my @parts = @{Mojo::Path->new->parse($path)->parts};
-
- # Shortcut
- return 1 unless @parts;
-
- # Prevent directory traversal
- return 1 if $parts[0] eq '..';
-
- # Serve static file
- return $self->serve($c, join('/', @parts));
-}
-
-sub serve {
- my ($self, $c, $rel) = @_;
-
- # Append path to root
- my $path = File::Spec->catfile($self->root, split('/', $rel));
-
- # Extension
- $path =~ /\.(\w+)$/;
- my $ext = $1;
-
- # Type
- my $type = $self->types->type($ext) || 'text/plain';
-
- # Response
- my $res = $c->res;
-
- # Asset
- my $asset;
-
- # Modified
- my $modified = $self->{_modified} ||= time;
-
- # Size
- my $size = 0;
-
- # File
- if (-f $path) {
-
- # Readable
- if (-r $path) {
-
- # Modified
- my $stat = stat($path);
- $modified = $stat->mtime;
-
- # Size
- $size = $stat->size;
-
- # Content
- $asset = Mojo::Asset::File->new(path => $path);
- }
-
- # Exists, but is forbidden
- else {
- $c->app->log->debug('File forbidden.');
- $res->code(403) and return;
- }
- }
-
- # Inline file
- elsif (defined(my $file = $self->_get_inline_file($c, $rel))) {
- $size = length $file;
- $asset = Mojo::Asset::Memory->new->add_chunk($file);
- }
-
- # Found
- if ($asset) {
-
- # Log
- $c->app->log->debug(qq/Serving static file "$rel"./);
-
- # Resume
- $c->tx->resume;
-
- # Request
- my $req = $c->req;
-
- # Request headers
- my $rqh = $req->headers;
-
- # Response headers
- my $rsh = $res->headers;
-
- # If modified since
- if (my $date = $rqh->if_modified_since) {
-
- # Not modified
- my $since = Mojo::Date->new($date)->epoch;
- if (defined $since && $since == $modified) {
- $c->app->log->debug('File not modified.');
- $res->code(304);
- $rsh->remove('Content-Type');
- $rsh->remove('Content-Length');
- $rsh->remove('Content-Disposition');
- return;
- }
- }
-
- # Start and end
- my $start = 0;
- my $end = $size - 1 >= 0 ? $size - 1 : 0;
-
- # Range
- if (my $range = $rqh->range) {
- if ($range =~ m/^bytes=(\d+)\-(\d+)?/ && $1 <= $end) {
- $start = $1;
- $end = $2 if defined $2 && $2 <= $end;
- $res->code(206);
- $rsh->content_length($end - $start + 1);
- $rsh->content_range("bytes $start-$end/$size");
- $c->app->log->debug("Range request: $start-$end/$size.");
- }
- else {
-
- # Not satisfiable
- $res->code(416);
- return;
- }
- }
- $asset->start_range($start);
- $asset->end_range($end);
-
- # Response
- $res->code(200) unless $res->code;
- $res->content->asset($asset);
- $rsh->content_type($type);
- $rsh->accept_ranges('bytes');
- $rsh->last_modified(Mojo::Date->new($modified));
- return;
- }
-
- return 1;
-}
-
-sub serve_404 { shift->serve_error(shift, 404) }
-
-sub serve_500 { shift->serve_error(shift, 500) }
-
-sub serve_error {
- my ($self, $c, $code, $rel) = @_;
-
- # Shortcut
- return 1 unless $c && $code;
-
- my $res = $c->res;
-
- # Render once
- return if ($res->code || '') eq $code;
-
- # Code
- $res->code($code);
-
- # Default to "code.html"
- $rel ||= "$code.html";
-
- # File
- if (!$self->serve($c, $rel)) {
-
- # Log
- $c->app->log->debug(qq/Serving error file "$rel"./);
- }
-
- # 404
- elsif ($code == 404) {
-
- # Log
- $c->app->log->debug('Serving 404 error.');
-
- $res->headers->content_type('text/html');
- $res->body(<<'EOF');
-<!doctype html><html>
- <head><title>File Not Found</title></head>
- <body><h2>File Not Found</h2></body>
-</html>
-EOF
- }
-
- # Error
- else {
-
- # Log
- $c->app->log->debug(qq/Serving error "$code"./);
-
- $res->headers->content_type('text/html');
- $res->body(<<'EOF');
-<!doctype html><html>
- <head><title>Internal Server Error</title></head>
- <body><h2>Internal Server Error</h2></body>
-</html>
-EOF
- }
-
- return;
-}
-
-sub _get_inline_file {
- my ($self, $c, $rel) = @_;
-
- # Protect templates
- return if $rel =~ /\.\w+\.\w+$/;
-
- # Class
- my $class =
- $c->stash->{static_class}
- || $ENV{MOJO_STATIC_CLASS}
- || $self->default_static_class
- || 'main';
-
- # Inline files
- my $inline = $self->{_inline_files}->{$class};
- unless ($inline) {
- my $files = Mojo::Command->new->get_all_data($class) || {};
- $inline = $self->{_inline_files}->{$class} = [keys %$files];
- }
-
- # Find
- for my $path (@$inline) {
- return Mojo::Command->new->get_data($path, $class) if $path eq $rel;
- }
-
- # Nothing
- return;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Dispatcher::Static - Serve Static Files
-
-=head1 SYNOPSIS
-
- use MojoX::Dispatcher::Static;
-
- # New dispatcher
- my $dispatcher = MojoX::Dispatcher::Static->new(
- prefix => '/images',
- root => '/ftp/pub/images'
- );
-
- # Dispatch
- my $success = $dispatcher->dispatch($c);
-
-=head1 DESCRIPTION
-
-L<MojoX::Dispatcher::Static> is a dispatcher for static files with C<Range>
-and C<If-Modified-Since> support.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Dispatcher::Static> implements the following attributes.
-
-=head2 C<default_static_class>
-
- my $class = $dispatcher->default_static_class;
- $dispatcher = $dispatcher->default_static_class('main');
-
-The dispatcher will use this class to look for files in the C<DATA> section.
-
-=head2 C<prefix>
-
- my $prefix = $dispatcher->prefix;
- $dispatcher = $dispatcher->prefix('/static');
-
-Prefix path to remove from incoming paths before dispatching.
-
-=head2 C<types>
-
- my $types = $dispatcher->types;
- $dispatcher = $dispatcher->types(MojoX::Types->new);
-
-MIME types, by default a L<MojoX::Types> object.
-
-=head2 C<root>
-
- my $root = $dispatcher->root;
- $dispatcher = $dispatcher->root('/foo/bar/files');
-
-Directory to serve static files from.
-
-=head1 METHODS
-
-L<MojoX::Dispatcher::Static> inherits all methods from L<Mojo::Base> and
-implements the following ones.
-
-=head2 C<dispatch>
-
- my $success = $dispatcher->dispatch($c);
-
-Dispatch a L<MojoX::Controller> object.
-
-=head2 C<serve>
-
- my $success = $dispatcher->serve($c, 'foo/bar.html');
-
-Serve a specific file.
-
-=head2 C<serve_404>
-
- my $success = $dispatcher->serve_404($c);
- my $success = $dispatcher->serve_404($c, '404.html');
-
-Serve a C<404> error page, guaranteed to render at least a default page.
-
-=head2 C<serve_500>
-
- my $success = $dispatcher->serve_500($c);
- my $success = $dispatcher->serve_500($c, '500.html');
-
-Serve a C<500> error page, guaranteed to render at least a default page.
-
-=head2 C<serve_error>
-
- my $success = $dispatcher->serve_error($c, 404);
- my $success = $dispatcher->serve_error($c, 404, '404.html');
-
-Serve error page, guaranteed to render at least a default page.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,514 +0,0 @@
-package MojoX::Renderer;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use File::Spec;
-use Mojo::ByteStream 'b';
-use Mojo::Command;
-use Mojo::Home;
-use Mojo::JSON;
-use MojoX::Types;
-use Mojo::Util 'encode';
-
-__PACKAGE__->attr(default_format => 'html');
-__PACKAGE__->attr([qw/default_handler default_template_class/]);
-__PACKAGE__->attr(detect_templates => 1);
-__PACKAGE__->attr(encoding => 'UTF-8');
-__PACKAGE__->attr(handler => sub { {} });
-__PACKAGE__->attr(helper => sub { {} });
-__PACKAGE__->attr(layout_prefix => 'layouts');
-__PACKAGE__->attr(root => '/');
-__PACKAGE__->attr(types => sub { MojoX::Types->new });
-
-# This is not how Xmas is supposed to be.
-# In my day Xmas was about bringing people together, not blowing them apart.
-sub new {
- my $self = shift->SUPER::new(@_);
-
- # Data
- $self->add_handler(
- data => sub {
- my ($r, $c, $output, $options) = @_;
- $$output = $options->{data};
- }
- );
-
- # JSON
- $self->add_handler(
- json => sub {
- my ($r, $c, $output, $options) = @_;
- $$output = Mojo::JSON->new->encode($options->{json});
- }
- );
-
- # Text
- $self->add_handler(
- text => sub {
- my ($r, $c, $output, $options) = @_;
- $$output = $options->{text};
- }
- );
-
- return $self;
-}
-
-sub add_handler {
- my ($self, $name, $cb) = @_;
- $self->handler->{$name} = $cb;
- return $self;
-}
-
-sub add_helper {
- my ($self, $name, $cb) = @_;
- $self->helper->{$name} = $cb;
- return $self;
-}
-
-sub get_inline_template {
- my ($self, $options, $template) = @_;
- return Mojo::Command->new->get_data($template,
- $self->_detect_template_class($options));
-}
-
-# Bodies are for hookers and fat people.
-sub render {
- my ($self, $c, $args) = @_;
-
- # Stash
- my $stash = $c->stash;
-
- # Arguments
- $args ||= {};
-
- # Content
- my $content = $stash->{'mojo.content'} ||= {};
-
- # Partial
- my $partial = $args->{partial};
-
- # Localize extends and layout
- local $stash->{layout} = $partial ? undef : $stash->{layout};
- local $stash->{extends} = $partial ? undef : $stash->{extends};
-
- # Merge stash and arguments
- while (my ($key, $value) = each %$args) {
- $stash->{$key} = $value;
- }
-
- # Template
- my $template = delete $stash->{template};
-
- # Template class
- my $class = $stash->{template_class};
-
- # Format
- my $format = $stash->{format} || $self->default_format;
-
- # Handler
- my $handler = $stash->{handler};
-
- # Data
- my $data = delete $stash->{data};
-
- # JSON
- my $json = delete $stash->{json};
-
- # Text
- my $text = delete $stash->{text};
-
- # Inline
- my $inline = delete $stash->{inline};
- $handler = $self->default_handler if defined $inline && !defined $handler;
-
- my $options = {
- template => $template,
- format => $format,
- handler => $handler,
- encoding => $self->encoding,
- inline => $inline,
- template_class => $class
- };
- my $output;
-
- # Text
- if (defined $text) {
-
- # Render
- $self->handler->{text}->($self, $c, \$output, {text => $text});
-
- # Extends
- $content->{content} = b("$output")
- if ($c->stash->{extends} || $c->stash->{layout});
- }
-
- # Data
- elsif (defined $data) {
-
- # Render
- $self->handler->{data}->($self, $c, \$output, {data => $data});
-
- # Extends
- $content->{content} = b("$output")
- if ($c->stash->{extends} || $c->stash->{layout});
- }
-
- # JSON
- elsif (defined $json) {
-
- # Render
- $self->handler->{json}->($self, $c, \$output, {json => $json});
- $format = 'json';
-
- # Extends
- $content->{content} = b("$output")
- if ($c->stash->{extends} || $c->stash->{layout});
- }
-
- # Template or templateless handler
- else {
-
- # Render
- return unless $self->_render_template($c, \$output, $options);
-
- # Extends
- $content->{content} = b("$output")
- if ($c->stash->{extends} || $c->stash->{layout});
- }
-
- # Extends
- while ((my $extends = $self->_extends($c)) && !$json && !$data) {
-
- # Stash
- my $stash = $c->stash;
-
- # Template class
- $class = $stash->{template_class};
- $options->{template_class} = $class;
-
- # Handler
- $handler = $stash->{handler};
- $options->{handler} = $handler;
-
- # Format
- $format = $stash->{format} || $self->default_format;
- $options->{format} = $format;
-
- # Template
- $options->{template} = $extends;
-
- # Render
- $self->_render_template($c, \$output, $options);
- }
-
- # Encoding (JSON is already encoded)
- unless ($partial) {
- my $encoding = $options->{encoding};
- encode $encoding, $output if $encoding && $output && !$json && !$data;
- }
-
- # Type
- my $type = $self->types->type($format) || 'text/plain';
-
- return ($output, $type);
-}
-
-sub template_name {
- my ($self, $options) = @_;
-
- # Template
- return unless my $template = $options->{template} || '';
-
- # Format
- return unless my $format = $options->{format};
-
- # Handler
- my $handler = $options->{handler};
-
- # File
- my $file = "$template.$format";
- $file = "$file.$handler" if $handler;
-
- return $file;
-}
-
-sub template_path {
- my $self = shift;
- return unless my $name = $self->template_name(shift);
- return File::Spec->catfile($self->root, split '/', $name);
-}
-
-sub _detect_handler {
- my ($self, $options) = @_;
-
- # Disabled
- return unless $self->detect_templates;
-
- # Template class
- my $class = $self->_detect_template_class($options);
-
- # Templates
- my $templates = $self->{_templates};
- unless ($templates) {
- $templates = $self->{_templates} =
- Mojo::Home->new->parse($self->root)->list_files;
- }
-
- # Inline templates
- my $inline = $self->{_inline_templates}->{$class}
- ||= $self->_list_inline_templates($class);
-
- # Detect
- return unless my $file = $self->template_name($options);
- $file = quotemeta $file;
- for my $template (@$templates, @$inline) {
- if ($template =~ /^$file\.(\w+)$/) { return $1 }
- }
-
- return;
-}
-
-# You are hereby conquered.
-# Please line up in order of how much beryllium it takes to kill you.
-sub _detect_template_class {
- my ($self, $options) = @_;
- return
- $options->{template_class}
- || $ENV{MOJO_TEMPLATE_CLASS}
- || $self->default_template_class
- || 'main';
-}
-
-sub _extends {
- my ($self, $c) = @_;
-
- # Layout
- my $stash = $c->stash;
- if (my $layout = delete $stash->{layout}) {
- $stash->{extends} ||= $self->layout_prefix . '/' . $layout;
- }
-
- # Extends
- return delete $stash->{extends};
-}
-
-sub _list_inline_templates {
- my ($self, $class) = @_;
-
- # Get all
- my $all = Mojo::Command->new->get_all_data($class);
-
- # List
- return [keys %$all];
-}
-
-# Well, at least here you'll be treated with dignity.
-# Now strip naked and get on the probulator.
-sub _render_template {
- my ($self, $c, $output, $options) = @_;
-
- # Renderer
- my $handler =
- $options->{handler}
- || $self->_detect_handler($options)
- || $self->default_handler;
- $options->{handler} = $handler;
- my $renderer = $self->handler->{$handler};
-
- # No handler
- unless ($renderer) {
- $c->app->log->error(qq/No handler for "$handler" available./);
- return;
- }
-
- # Render
- return unless $renderer->($self, $c, $output, $options);
-
- # Success!
- return 1;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Renderer - MIME Type Based Renderer
-
-=head1 SYNOPSIS
-
- use MojoX::Renderer;
-
- my $renderer = MojoX::Renderer->new;
-
-=head1 DESCRIPTION
-
-L<MojoX::Renderer> is the standard L<Mojolicious> renderer.
-It turns your stashed data structures into content.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Types> implements the following attributes.
-
-=head2 C<default_format>
-
- my $default = $renderer->default_format;
- $renderer = $renderer->default_format('html');
-
-The default format to render if C<format> is not set in the stash.
-The renderer will use L<MojoX::Types> to look up the content MIME type.
-
-=head2 C<default_handler>
-
- my $default = $renderer->default_handler;
- $renderer = $renderer->default_handler('epl');
-
-The default template handler to use for rendering in cases where auto
-detection doesn't work, like for C<inline> templates.
-
-=over 4
-
-=item epl
-
-C<Embedded Perl Lite> handled by L<Mojolicious::Plugin::EplRenderer>.
-
-=item ep
-
-C<Embedded Perl> handled by L<Mojolicious::Plugin::EpRenderer>.
-
-=back
-
-=head2 C<default_template_class>
-
- my $default = $renderer->default_template_class;
- $renderer = $renderer->default_template_class('main');
-
-The renderer will use this class to look for templates in the C<DATA>
-section.
-
-=head2 C<detect_templates>
-
- my $detect = $renderer->detect_templates;
- $renderer = $renderer->detect_templates(1);
-
-Template auto detection, the renderer will try to select the right template
-and renderer automatically.
-
-=head2 C<encoding>
-
- my $encoding = $renderer->encoding;
- $renderer = $renderer->encoding('koi8-r');
-
-Will encode the content if set, defaults to C<UTF-8>.
-
-=head2 C<handler>
-
- my $handler = $renderer->handler;
- $renderer = $renderer->handler({epl => sub { ... }});
-
-Registered handlers.
-
-=head2 C<helper>
-
- my $helper = $renderer->helper;
- $renderer = $renderer->helper({url_for => sub { ... }});
-
-Registered helpers.
-
-=head2 C<layout_prefix>
-
- my $prefix = $renderer->layout_prefix;
- $renderer = $renderer->layout_prefix('layouts');
-
-Directory to look for layouts in, defaults to C<layouts>.
-
-=head2 C<root>
-
- my $root = $renderer->root;
- $renderer = $renderer->root('/foo/bar/templates');
-
-Directory to look for templates in.
-
-=head2 C<types>
-
- my $types = $renderer->types;
- $renderer = $renderer->types(MojoX::Types->new);
-
-L<MojoX::Types> object to use for looking up MIME types.
-
-=head1 METHODS
-
-L<MojoX::Renderer> inherits all methods from L<Mojo::Base> and implements the
-following ones.
-
-=head2 C<new>
-
- my $renderer = MojoX::Renderer->new;
-
-Construct a new renderer.
-
-=head2 C<add_handler>
-
- $renderer = $renderer->add_handler(epl => sub { ... });
-
-Add a new handler to the renderer.
-See L<Mojolicious::Plugin::EpRenderer> for a sample renderer.
-
-=head2 C<add_helper>
-
- $renderer = $renderer->add_helper(url_for => sub { ... });
-
-Add a new helper to the renderer.
-See L<Mojolicious::Plugin::EpRenderer> for sample helpers.
-
-=head2 C<get_inline_template>
-
- my $template = $renderer->get_inline_template({
- template => 'foo/bar',
- format => 'html',
- handler => 'epl'
- template_class => 'main'
- }, 'foo.html.ep');
-
-Get an inline template by name, usually used by handlers.
-
-=head2 C<render>
-
- my ($output, $type) = $renderer->render($c);
- my ($output, $type) = $renderer->render($c, $args);
-
-Render output through one of the Mojo renderers.
-This renderer requires some configuration, at the very least you will need to
-have a default C<format> and a default C<handler> as well as a C<template> or
-C<text>/C<json>.
-See L<Mojolicious::Controller> for a more user friendly interface.
-
-=head2 C<template_name>
-
- my $template = $renderer->template_name({
- template => 'foo/bar',
- format => 'html',
- handler => 'epl'
- });
-
-Builds a template name based on an options hash with C<template>, C<format>
-and C<handler>.
-
-=head2 C<template_path>
-
- my $path = $renderer->template_path({
- template => 'foo/bar',
- format => 'html',
- handler => 'epl'
- });
-
-Builds a full template path based on an options hash with C<template>,
-C<format> and C<handler>.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,327 +0,0 @@
-package MojoX::Routes::Match;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use Carp 'croak';
-use Mojo::Util qw/decode url_unescape/;
-use Mojo::URL;
-use Scalar::Util 'weaken';
-
-__PACKAGE__->attr(captures => sub { {} });
-__PACKAGE__->attr([qw/endpoint root/]);
-__PACKAGE__->attr(stack => sub { [] });
-
-# I'm Bender, baby, please insert liquor!
-sub new {
- my $self = shift->SUPER::new();
- my $c = shift;
-
- # Controller
- $self->{_controller} = $c;
- weaken $self->{_controller};
-
- # Path
- unless ($self->{_path} = shift) {
- $self->{_path} = $c->req->url->path->to_string;
- url_unescape $self->{_path};
- decode 'UTF8', $self->{_path};
- }
-
- return $self;
-}
-
-# Life can be hilariously cruel.
-sub match {
- my ($self, $r) = @_;
-
- # Shortcut
- return unless $r;
-
- # Dictionary
- my $dictionary = $self->{_dictionary} ||= $r->dictionary;
-
- # Root
- $self->root($r) unless $self->root;
-
- # Path
- my $path = $self->{_path};
-
- # Match
- my $captures = $r->pattern->shape_match(\$path);
-
- # No match
- return unless $captures;
-
- # Conditions
- for (my $i = 0; $i < @{$r->conditions}; $i += 2) {
- my $name = $r->conditions->[$i];
- my $value = $r->conditions->[$i + 1];
- my $condition = $dictionary->{$name};
-
- # No condition
- return unless $condition;
-
- # Match
- return
- if !$condition->($r, $self->{_controller}, $self->captures, $value);
- }
-
- # Partial
- if (my $partial = $r->partial) {
- $captures->{$partial} = $path;
- $path = '';
- }
- $self->{_path} = $path;
-
- # Merge captures
- $captures = {%{$self->captures}, %$captures};
- $self->captures($captures);
-
- # Format
- if ($r->is_endpoint && !$r->pattern->format) {
- if ($path =~ /^\.([^\/]+)$/) {
- $self->captures->{format} = $1;
- $self->{_path} = '';
- }
- }
- $self->captures->{format} ||= $r->pattern->format if $r->pattern->format;
-
- # Update stack
- if ($r->inline || ($r->is_endpoint && $self->_is_path_empty)) {
- push @{$self->stack}, {%$captures};
- delete $captures->{cb};
- delete $captures->{app};
- }
-
- # Waypoint match
- if ($r->block && $self->_is_path_empty) {
- $self->endpoint($r);
- return $self;
- }
-
- # Match children
- my $snapshot = [@{$self->stack}];
- for my $child (@{$r->children}) {
-
- # Match
- $self->match($child);
-
- # Endpoint found
- return $self if $self->endpoint;
-
- # Reset path
- $self->{_path} = $path;
-
- # Reset stack
- if ($r->parent) { $self->stack([@$snapshot]) }
- else {
- $self->captures({});
- $self->stack([]);
- }
- }
-
- $self->endpoint($r) if $r->is_endpoint && $self->_is_path_empty;
-
- return $self;
-}
-
-sub url_for {
- my $self = shift;
- my $endpoint = $self->endpoint;
- my $values = {};
- my $name = undef;
-
- # Single argument
- if (@_ == 1) {
-
- # Hash
- $values = shift if ref $_[0] eq 'HASH';
-
- # Name
- $name = $_[0] if $_[0];
- }
-
- # Multiple arguments
- elsif (@_ > 1) {
-
- # Odd
- if (@_ % 2) {
- $name = shift;
- $values = {@_};
- }
-
- # Even
- else {
-
- # Name and hashref
- if (ref $_[1] eq 'HASH') {
- $name = shift;
- $values = shift;
- }
-
- # Just values
- else { $values = {@_} }
-
- }
- }
-
- # Captures
- my $captures = $self->captures;
-
- # Named
- if ($name) {
-
- # Current route
- if ($name eq 'current') { $name = undef }
-
- # Find
- else {
- $captures = {};
- croak qq/Route "$name" used in url_for does not exist/
- unless $endpoint = $self->_find_route($name);
- }
- }
-
- # Merge values
- $values = {%$captures, format => undef, %$values};
-
- # URL
- my $url = Mojo::URL->new;
-
- # No endpoint
- return $url unless $endpoint;
-
- # Base
- $url->base($self->{_controller}->req->url->base->clone);
- my $base = $url->base;
- $url->base->userinfo(undef);
-
- # Render
- my $path = $endpoint->render($url->path->to_string, $values);
- $url->path->parse($path);
-
- # Fix scheme
- if ($endpoint->is_websocket) {
- $base->scheme(($base->scheme || '') eq 'https' ? 'wss' : 'ws');
- }
-
- # Fix paths
- unshift @{$url->path->parts}, @{$base->path->parts};
- $base->path->parts([]);
-
- return $url;
-}
-
-sub _find_route {
- my ($self, $name) = @_;
-
- # Find endpoint
- my @children = ($self->root);
- while (my $child = shift @children) {
-
- # Match
- return $child if ($child->name || '') eq $name;
-
- # Append
- push @children, @{$child->children};
- }
-
- # Not found
- return;
-}
-
-sub _is_path_empty {
- my $self = shift;
- return 1 if !length $self->{_path} || $self->{_path} eq '/';
- return;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Routes::Match - Routes Visitor
-
-=head1 SYNOPSIS
-
- use MojoX::Routes::Match;
-
- # New match object
- my $m = MojoX::Routes::Match->new($c);
-
- # Match
- $m->match($routes);
-
-=head1 DESCRIPTION
-
-L<MojoX::Routes::Match> is a visitor for L<MojoX::Routes> structures.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Routes::Match> implements the following attributes.
-
-=head2 C<captures>
-
- my $captures = $m->captures;
- $m = $m->captures({foo => 'bar'});
-
-Captured parameters.
-
-=head2 C<endpoint>
-
- my $endpoint = $m->endpoint;
- $m = $m->endpoint(MojoX::Routes->new);
-
-The routes endpoint that actually matched.
-
-=head2 C<root>
-
- my $root = $m->root;
- $m = $m->root($routes);
-
-The root of the routes tree.
-
-=head2 C<stack>
-
- my $stack = $m->stack;
- $m = $m->stack([{foo => 'bar'}]);
-
-Captured parameters with nesting history.
-
-=head1 METHODS
-
-L<MojoX::Routes::Match> inherits all methods from L<Mojo::Base> and
-implements the following ones.
-
-=head2 C<new>
-
- my $m = MojoX::Routes::Match->new(MojoX:Controller->new);
-
-Construct a new match object.
-
-=head2 C<match>
-
- $m->match(MojoX::Routes->new);
-
-Match against a routes tree.
-
-=head2 C<url_for>
-
- my $url = $m->url_for;
- my $url = $m->url_for(foo => 'bar');
- my $url = $m->url_for({foo => 'bar'});
- my $url = $m->url_for('named');
- my $url = $m->url_for('named', foo => 'bar');
- my $url = $m->url_for('named', {foo => 'bar'});
-
-Render matching route with parameters into a L<Mojo::URL> object.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,456 +0,0 @@
-package MojoX::Routes::Pattern;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use constant DEBUG => $ENV{MOJOX_ROUTES_DEBUG} || 0;
-
-__PACKAGE__->attr(defaults => sub { {} });
-__PACKAGE__->attr([qw/format pattern regex/]);
-__PACKAGE__->attr(quote_end => ')');
-__PACKAGE__->attr(quote_start => '(');
-__PACKAGE__->attr(relaxed_start => '.');
-__PACKAGE__->attr(reqs => sub { {} });
-__PACKAGE__->attr(symbol_start => ':');
-__PACKAGE__->attr(symbols => sub { [] });
-__PACKAGE__->attr(tree => sub { [] });
-__PACKAGE__->attr(wildcard_start => '*');
-
-# This is the worst kind of discrimination. The kind against me!
-sub new {
- my $self = shift->SUPER::new();
- $self->parse(@_);
- return $self;
-}
-
-sub match {
- my ($self, $path) = @_;
-
- # Match
- my $result = $self->shape_match(\$path);
-
- # Endpoint
- return $result if !$path || $path eq '/';
-
- # Partial or no match
- return;
-}
-
-sub parse {
- my $self = shift;
- my $pattern = shift;
-
- # Shortcut
- return $self unless defined $pattern;
-
- # Make sure pattern starts with a slash
- $pattern = "/$pattern" unless $pattern =~ /^\//;
-
- # Format
- if ($pattern =~ /\.([^\/\)]+)$/) { $self->format($1) }
-
- # Requirements
- my $reqs = ref $_[0] eq 'HASH' ? $_[0] : {@_};
- $self->reqs($reqs);
-
- # Tokenize
- $self->pattern($pattern);
- $self->_tokenize;
-
- return $self;
-}
-
-sub render {
- my ($self, $values) = @_;
-
- # Merge values with defaults
- $values ||= {};
- $values = {%{$self->defaults}, %$values};
-
- my $string = '';
- my $optional = 1;
- for my $token (reverse @{$self->tree}) {
- my $op = $token->[0];
- my $rendered = '';
-
- # Slash
- if ($op eq 'slash') {
- $rendered = '/' unless $optional;
- }
-
- # Text
- elsif ($op eq 'text') {
- $rendered = $token->[1];
- $optional = 0;
- }
-
- # Relaxed, symbol or wildcard
- elsif ($op eq 'relaxed' || $op eq 'symbol' || $op eq 'wildcard') {
- my $name = $token->[1];
- $rendered = $values->{$name};
- $rendered = '' unless defined $rendered;
-
- my $default = $self->defaults->{$name};
- $default = '' unless defined $default;
-
- $optional = 0 unless $default eq $rendered;
- $rendered = '' if $optional && $default eq $rendered;
- }
-
- $string = "$rendered$string";
- }
-
- return $string || '/';
-}
-
-sub shape_match {
- my ($self, $pathref) = @_;
-
- # Debug
- if (DEBUG) {
- my $pattern = $self->pattern || '';
- warn " [$$pathref] -> [$pattern]\n";
- }
-
- # Compile on demand
- $self->_compile unless $self->regex;
-
- my $regex = $self->regex;
-
- # Debug
- warn " $regex\n" if DEBUG;
-
- # Match
- if (my @captures = $$pathref =~ /$regex/) {
-
- # Substitute
- $$pathref =~ s/$regex//;
-
- # Merge captures
- my $result = {%{$self->defaults}};
- for my $symbol (@{$self->symbols}) {
-
- # No captures
- last unless @captures;
-
- # Merge
- my $capture = shift @captures;
- $result->{$symbol} = $capture if defined $capture;
- }
- return $result;
- }
-
- return;
-}
-
-sub _compile {
- my $self = shift;
-
- my $block = '';
- my $regex = '';
- my $optional = 1;
- for my $token (reverse @{$self->tree}) {
- my $op = $token->[0];
- my $compiled = '';
-
- # Slash
- if ($op eq 'slash') {
-
- # Full block
- $block = $optional ? "(?:/$block)?" : "/$block";
-
- $regex = "$block$regex";
- $block = '';
-
- next;
- }
-
- # Text
- elsif ($op eq 'text') {
- $compiled = $token->[1];
- $optional = 0;
- }
-
- # Symbol
- elsif ($op eq 'relaxed' || $op eq 'symbol' || $op eq 'wildcard') {
- my $name = $token->[1];
-
- unshift @{$self->symbols}, $name;
-
- # Relaxed
- if ($op eq 'relaxed') { $compiled = '([^\/]+)' }
-
- # Symbol
- elsif ($op eq 'symbol') { $compiled = '([^\/\.]+)' }
-
- # Wildcard
- elsif ($op eq 'wildcard') { $compiled = '(.+)' }
-
- my $req = $self->reqs->{$name};
- $compiled = "($req)" if $req;
-
- $optional = 0 unless exists $self->defaults->{$name};
-
- $compiled .= '?' if $optional;
- }
-
- # Add to block
- $block = "$compiled$block";
- }
-
- # Not rooted with a slash
- $regex = "$block$regex" if $block;
-
- $regex = qr/^$regex/;
- $self->regex($regex);
-
- return $self;
-}
-
-sub _tokenize {
- my $self = shift;
-
- my $pattern = $self->pattern;
- my $quote_end = $self->quote_end;
- my $quote_start = $self->quote_start;
- my $relaxed_start = $self->relaxed_start;
- my $symbol_start = $self->symbol_start;
- my $wildcard_start = $self->wildcard_start;
-
- my $tree = [];
- my $state = 'text';
-
- my $quoted = 0;
- while (length(my $char = substr $pattern, 0, 1, '')) {
-
- # Inside a symbol
- my $symbol = 0;
- $symbol = 1
- if $state eq 'relaxed'
- || $state eq 'symbol'
- || $state eq 'wildcard';
-
- # Quote start
- if ($char eq $quote_start) {
- $quoted = 1;
- $state = 'symbol';
- push @$tree, ['symbol', ''];
- next;
- }
-
- # Symbol start
- if ($char eq $symbol_start) {
- push @$tree, ['symbol', ''] if $state ne 'symbol';
- $state = 'symbol';
- next;
- }
-
- # Relaxed start
- if ($quoted && $char eq $relaxed_start) {
-
- # Upgrade relaxed to wildcard
- if ($state eq 'symbol') {
- $state = 'relaxed';
- $tree->[-1]->[0] = 'relaxed';
- next;
- }
-
- }
-
- # Wildcard start
- if ($quoted && $char eq $wildcard_start) {
-
- # Upgrade relaxed to wildcard
- if ($state eq 'symbol') {
- $state = 'wildcard';
- $tree->[-1]->[0] = 'wildcard';
- next;
- }
-
- }
-
- # Quote end
- if ($char eq $quote_end) {
- $quoted = 0;
- $state = 'text';
- next;
- }
-
- # Slash
- if ($char eq '/') {
- push @$tree, ['slash'];
- $state = 'text';
- next;
- }
-
- # Relaxed, symbol or wildcard
- elsif ($symbol && $char =~ /\w/) {
- $tree->[-1]->[-1] .= $char;
- next;
- }
-
- # Text
- else {
-
- $state = 'text';
-
- # New text element
- unless ($tree->[-1]->[0] eq 'text') {
- push @$tree, ['text', $char];
- next;
- }
-
- # More text
- $tree->[-1]->[-1] .= $char;
- }
- }
-
- $self->tree($tree);
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Routes::Pattern - Routes Pattern
-
-=head1 SYNOPSIS
-
- use MojoX::Routes::Pattern;
-
- # New pattern object
- my $pattern = MojoX::Routes::Pattern->new;
-
-=head1 DESCRIPTION
-
-L<MojoX::Routes::Pattern> is a container for routes pattern which are used to
-match paths against.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Routes::Pattern> implements the following attributes.
-
-=head2 C<defaults>
-
- my $defaults = $pattern->defaults;
- $pattern = $pattern->defaults({foo => 'bar'});
-
-Default parameters.
-
-=head2 C<pattern>
-
- my $pattern = $pattern->pattern;
- $pattern = $pattern->pattern('/(foo)/(bar)');
-
-Raw unparsed pattern.
-
-=head2 C<quote_end>
-
- my $quote = $pattern->quote_end;
- $pattern = $pattern->quote_end(']');
-
-Character indicating the end of a quoted placeholder, defaults to C<)>.
-
-=head2 C<quote_start>
-
- my $quote = $pattern->quote_start;
- $pattern = $pattern->quote_start('[');
-
-Character indicating the start of a quoted placeholder, defaults to C<(>.
-
-=head2 C<regex>
-
- my $regex = $pattern->regex;
- $pattern = $pattern->regex(qr/\/foo/);
-
-Pattern in compiled regex form.
-
-=head2 C<relaxed_start>
-
- my $relaxed = $pattern->relaxed_start;
- $pattern = $pattern->relaxed_start('*');
-
-Character indicating a relaxed placeholder, defaults to C<.>.
-
-=head2 C<reqs>
-
- my $reqs = $pattern->reqs;
- $pattern = $pattern->reqs({foo => qr/\w+/});
-
-Regex constraints.
-
-=head2 C<symbol_start>
-
- my $symbol = $pattern->symbol_start;
- $pattern = $pattern->symbol_start(':');
-
-Character indicating a placeholder, defaults to C<:>.
-
-=head2 C<symbols>
-
- my $symbols = $pattern->symbols;
- $pattern = $pattern->symbols(['foo', 'bar']);
-
-Placeholder names.
-
-=head2 C<tree>
-
- my $tree = $pattern->tree;
- $pattern = $pattern->tree([ ... ]);
-
-Pattern in parsed form.
-
-=head2 C<wildcard_start>
-
- my $wildcard = $pattern->wildcard_start;
- $pattern = $pattern->wildcard_start('*');
-
-Character indicating the start of a wildcard placeholder, defaults to C<*>.
-
-=head1 METHODS
-
-L<MojoX::Routes::Pattern> inherits all methods from L<Mojo::Base> and
-implements the following ones.
-
-=head2 C<new>
-
- my $pattern = MojoX::Routes::Pattern->new('/:controller/:action',
- action => qr/\w+/
- );
-
-Construct a new pattern object.
-
-=head2 C<match>
-
- my $result = $pattern->match('/foo/bar');
-
-Match pattern against a path.
-
-=head2 C<parse>
-
- $pattern = $pattern->parse('/:controller/:action', action => qr/\w+/);
-
-Parse a raw pattern.
-
-=head2 C<render>
-
- my $path = $pattern->render({action => 'foo'});
-
-Render pattern into a path with parameters.
-
-=head2 C<shape_match>
-
- my $result = $pattern->shape_match(\$path);
-
-Match pattern against a path and remove matching parts.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,510 +0,0 @@
-package MojoX::Routes;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use Mojo::URL;
-use MojoX::Routes::Pattern;
-use Scalar::Util 'weaken';
-
-__PACKAGE__->attr([qw/block inline parent partial/]);
-__PACKAGE__->attr([qw/children conditions/] => sub { [] });
-__PACKAGE__->attr(dictionary => sub { {} });
-__PACKAGE__->attr(pattern => sub { MojoX::Routes::Pattern->new });
-
-# Yet thanks to my trusty safety sphere,
-# I sublibed with only tribial brain dablage.
-sub new {
- my $self = shift->SUPER::new();
-
- # Parse
- $self->parse(@_);
-
- # Method condition
- $self->add_condition(
- method => sub {
- my ($r, $c, $captures, $methods) = @_;
-
- # Methods
- return unless $methods && ref $methods eq 'ARRAY';
-
- # Match
- my $m = lc $c->req->method;
- $m = 'get' if $m eq 'head';
- for my $method (@$methods) {
- return 1 if $method eq $m;
- }
-
- # Nothing
- return;
- }
- );
-
- # WebSocket condition
- $self->add_condition(
- websocket => sub {
- my ($r, $c, $captures) = @_;
-
- # WebSocket
- return 1 if $c->tx->is_websocket;
-
- # Not a WebSocket
- return;
- }
- );
-
- return $self;
-}
-
-sub add_child {
- my ($self, $route) = @_;
-
- # We are the parent
- $route->parent($self);
- weaken $route->{parent};
-
- # Add to tree
- push @{$self->children}, $route;
-
- return $self;
-}
-
-sub add_condition {
- my ($self, $name, $condition) = @_;
-
- # Add
- $self->dictionary->{$name} = $condition;
-
- return $self;
-}
-
-sub bridge { shift->route(@_)->inline(1) }
-
-sub is_endpoint {
- my $self = shift;
- return if $self->inline;
- return 1 if $self->block;
- return if @{$self->children};
- return 1;
-}
-
-sub is_websocket {
- my $self = shift;
- return 1 if $self->{_websocket};
- if (my $parent = $self->parent) { return $parent->is_websocket }
- return;
-}
-
-# Dr. Zoidberg, can you note the time and declare the patient legally dead?
-# Can I! That’s my specialty!
-sub name {
- my ($self, $name) = @_;
-
- # New name
- if (defined $name) {
-
- # Generate
- if ($name eq '*') {
- $name = $self->pattern->pattern;
- $name =~ s/\W+//g;
- }
- $self->{_name} = $name;
-
- return $self;
- }
-
- return $self->{_name};
-}
-
-sub over {
- my $self = shift;
-
- # Shortcut
- return $self unless @_;
-
- # Conditions
- my $conditions = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
- push @{$self->conditions}, @$conditions;
-
- return $self;
-}
-
-sub parse {
- my $self = shift;
-
- # Pattern does the real work
- $self->pattern->parse(@_);
-
- return $self;
-}
-
-sub render {
- my ($self, $path, $values) = @_;
-
- # Path prefix
- my $prefix = $self->pattern->render($values);
- $path = $prefix . $path unless $prefix eq '/';
-
- # Make sure there is always a root
- $path = '/' if !$path && !$self->parent;
-
- # Format
- if ((my $format = $values->{format}) && !$self->parent) {
- $path .= ".$format" unless $path =~ /\.[^\/]+$/;
- }
-
- # Parent
- $path = $self->parent->render($path, $values) if $self->parent;
-
- return $path;
-}
-
-# Morbo forget how you spell that letter that looks like a man wearing a hat.
-# Hello, tiny man. I will destroy you!
-sub route {
- my $self = shift;
-
- # New route
- my $route = $self->new(@_);
- $self->add_child($route);
-
- return $route;
-}
-
-sub to {
- my $self = shift;
-
- # Shortcut
- return $self unless @_;
-
- # Single argument
- my ($shortcut, $defaults);
- if (@_ == 1) {
-
- # Hash
- $defaults = shift if ref $_[0] eq 'HASH';
- $shortcut = shift if $_[0];
- }
-
- # Multiple arguments
- else {
-
- # Odd
- if (@_ % 2) {
- $shortcut = shift;
- $defaults = {@_};
- }
-
- # Even
- else {
-
- # Shortcut and defaults
- if (ref $_[1] eq 'HASH') {
- $shortcut = shift;
- $defaults = shift;
- }
-
- # Just defaults
- else { $defaults = {@_} }
- }
- }
-
- # Shortcut
- if ($shortcut) {
-
- # App
- if (ref $shortcut || $shortcut =~ /^[\w\:]+$/) {
- $defaults->{app} = $shortcut;
- }
-
- # Controller and action
- elsif ($shortcut =~ /^([\w\-]+)?\#(\w+)?$/) {
- $defaults->{controller} = $1 if defined $1;
- $defaults->{action} = $2 if defined $2;
- }
- }
-
- # Pattern
- my $pattern = $self->pattern;
-
- # Defaults
- my $old = $pattern->defaults;
- $pattern->defaults({%$old, %$defaults}) if $defaults;
-
- return $self;
-}
-
-sub to_string {
- my $self = shift;
- my $pattern = $self->parent ? $self->parent->to_string : '';
- $pattern .= $self->pattern->pattern if $self->pattern->pattern;
- return $pattern;
-}
-
-sub via {
- my $self = shift;
-
- # Methods
- my $methods = ref $_[0] ? $_[0] : [@_];
-
- # Shortcut
- return $self unless @$methods;
-
- # Condition
- push @{$self->conditions}, method => [map { lc $_ } @$methods];
-
- return $self;
-}
-
-sub waypoint { shift->route(@_)->block(1) }
-
-sub websocket {
- my $self = shift;
-
- # Condition
- push @{$self->conditions}, websocket => 1;
- $self->{_websocket} = 1;
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Routes - Always Find Your Destination With Routes
-
-=head1 SYNOPSIS
-
- use MojoX::Routes;
-
- # New routes tree
- my $r = MojoX::Routes->new;
-
- # Normal route matching "/articles" with parameters "controller" and
- # "action"
- $r->route('/articles')->to(controller => 'article', action => 'list');
-
- # Route with a placeholder matching everything but "/" and "."
- $r->route('/:controller')->to(action => 'list');
-
- # Route with a placeholder and regex constraint
- $r->route('/articles/:id', id => qr/\d+/)
- ->to(controller => 'article', action => 'view');
-
- # Route with an optional parameter "year"
- $r->route('/archive/:year')
- ->to(controller => 'archive', action => 'list', year => undef);
-
- # Nested route for two actions sharing the same "controller" parameter
- my $books = $r->route('/books/:id')->to(controller => 'book');
- $books->route('/edit')->to(action => 'edit');
- $books->route('/delete')->to(action => 'delete');
-
- # Bridges can be used to chain multiple routes
- $r->bridge->to(controller => 'foo', action =>'auth')
- ->route('/blog')->to(action => 'list');
-
- # Waypoints are similar to bridges and nested routes but can also match
- # if they are not the actual endpoint of the whole route
- my $b = $r->waypoint('/books')->to(controller => 'books', action => 'list');
- $b->route('/:id', id => qr/\d+/)->to(action => 'view');
-
-=head1 DESCRIPTION
-
-L<MojoX::Routes> is a very powerful implementation of the famous routes
-pattern and the core of the L<Mojolicious> web framework.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Routes> implements the following attributes.
-
-=head2 C<block>
-
- my $block = $r->block;
- $r = $r->block(1);
-
-Allow this route to match even if it's not an endpoint, used for waypoints.
-
-=head2 C<children>
-
- my $children = $r->children;
- $r = $r->children([MojoX::Routes->new]);
-
-The children of this routes object, used for nesting routes.
-
-=head2 C<conditions>
-
- my $conditions = $r->conditions;
- $r = $r->conditions([foo => qr/\w+/]);
-
-Contains condition parameters for this route, used for C<over>.
-
-=head2 C<dictionary>
-
- my $dictionary = $r->dictionary;
- $r = $r->dictionary({foo => sub { ... }});
-
-Contains all available conditions for this route.
-There are currently two conditions built in, C<method> and C<websocket>.
-
-=head2 C<inline>
-
- my $inline = $r->inline;
- $r = $r->inline(1);
-
-Allow C<bridge> semantics for this route.
-
-=head2 C<parent>
-
- my $parent = $r->parent;
- $r = $r->parent(MojoX::Routes->new);
-
-The parent of this route, used for nesting routes.
-
-=head2 C<partial>
-
- my $partial = $r->partial;
- $r = $r->partial('path');
-
-Route has no specific end, remaining characters will be captured with the
-partial name.
-Note that this attribute is EXPERIMENTAL and might change without warning!
-
-=head2 C<pattern>
-
- my $pattern = $r->pattern;
- $r = $r->pattern(MojoX::Routes::Pattern->new);
-
-Pattern for this route, by default a L<MojoX::Routes::Pattern> object and
-used for matching.
-
-=head1 METHODS
-
-L<MojoX::Routes> inherits all methods from L<Mojo::Base> and implements the
-following ones.
-
-=head2 C<new>
-
- my $r = MojoX::Routes->new;
- my $r = MojoX::Routes->new('/:controller/:action');
-
-Construct a new route object.
-
-=head2 C<add_child>
-
- $r = $r->add_child(MojoX::Route->new);
-
-Add a new child to this route.
-
-=head2 C<add_condition>
-
- $r = $r->add_condition(foo => sub { ... });
-
-Add a new condition for this route.
-
-=head2 C<bridge>
-
- my $bridge = $r->bridge;
- my $bridge = $r->bridge('/:controller/:action');
-
-Add a new bridge to this route as a nested child.
-
-=head2 C<is_endpoint>
-
- my $is_endpoint = $r->is_endpoint;
-
-Returns true if this route qualifies as an endpoint.
-
-=head2 C<is_websocket>
-
- my $is_websocket = $r->is_websocket;
-
-Returns true if this route leads to a WebSocket.
-
-=head2 C<name>
-
- my $name = $r->name;
- $r = $r->name('foo');
- $r = $r->name('*');
-
-The name of this route, the special value C<*> will generate a name based on
-the route pattern.
-Note that the name C<current> is reserved for refering to the current route.
-
-=head2 C<over>
-
- $r = $r->over(foo => qr/\w+/);
-
-Apply condition parameters to this route.
-
-=head2 C<parse>
-
- $r = $r->parse('/:controller/:action');
-
-Parse a pattern.
-
-=head2 C<render>
-
- my $path = $r->render($path);
- my $path = $r->render($path, {foo => 'bar'});
-
-Render route with parameters into a path.
-
-=head2 C<route>
-
- my $route = $r->route('/:c/:a', a => qr/\w+/);
-
-Add a new nested child to this route.
-
-=head2 C<to>
-
- my $to = $r->to;
- $r = $r->to(action => 'foo');
- $r = $r->to({action => 'foo'});
- $r = $r->to('controller#action');
- $r = $r->to('controller#action', foo => 'bar');
- $r = $r->to('controller#action', {foo => 'bar'});
- $r = $r->to($app);
- $r = $r->to($app, foo => 'bar');
- $r = $r->to($app, {foo => 'bar'});
- $r = $r->to('MyApp');
- $r = $r->to('MyApp', foo => 'bar');
- $r = $r->to('MyApp', {foo => 'bar'});
-
-Set default parameters for this route.
-
-=head2 C<to_string>
-
- my $string = $r->to_string;
-
-Stringifies the whole route.
-
-=head2 C<via>
-
- $r = $r->via('get');
- $r = $r->via(qw/get post/);
- $r = $r->via([qw/get post/]);
-
-Apply C<method> constraint to this route.
-
-=head2 C<waypoint>
-
- my $route = $r->waypoint('/:c/:a', a => qr/\w+/);
-
-Add a waypoint to this route as nested child.
-
-=head2 C<websocket>
-
- $route->websocket;
-
-Apply C<websocket> constraint to this route.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,254 +0,0 @@
-package MojoX::Session::Cookie::Controller;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Controller';
-
-use Mojo::Cookie::Response;
-use Mojo::Transaction::HTTP;
-use Mojo::Util 'hmac_md5_sum';
-
-__PACKAGE__->attr(tx => sub { Mojo::Transaction::HTTP->new });
-
-# For the last time, I don't like lilacs!
-# Your first wife was the one who liked lilacs!
-# She also liked to shut up!
-sub cookie {
- my ($self, $name, $value, $options) = @_;
-
- # Shortcut
- return unless $name;
-
- # Response cookie
- if (defined $value) {
-
- # Cookie too big
- $self->app->log->error(qq/Cookie "$name" is bigger than 4096 bytes./)
- if length $value > 4096;
-
- # Create new cookie
- $options ||= {};
- my $cookie = Mojo::Cookie::Response->new(
- name => $name,
- value => $value,
- %$options
- );
- $self->res->cookies($cookie);
- return $self;
- }
-
- # Request cookie
- unless (wantarray) {
- return unless my $cookie = $self->req->cookie($name);
- return $cookie->value;
- }
-
- # Request cookies
- my @cookies = $self->req->cookie($name);
- return map { $_->value } @cookies;
-}
-
-# You two make me ashamed to call myself an idiot.
-sub flash {
- my $self = shift;
-
- # Get
- my $session = $self->stash->{'mojo.session'};
- if ($_[0] && !defined $_[1] && !ref $_[0]) {
- return unless $session && ref $session eq 'HASH';
- return unless my $flash = $session->{old_flash};
- return unless ref $flash eq 'HASH';
- return $flash->{$_[0]};
- }
-
- # Initialize
- $session = $self->session;
- my $flash = $session->{flash};
- $flash = {} unless $flash && ref $flash eq 'HASH';
- $session->{flash} = $flash;
-
- # Hash
- return $flash unless @_;
-
- # Set
- my $values = exists $_[1] ? {@_} : $_[0];
- $session->{flash} = {%$flash, %$values};
-
- return $self;
-}
-
-sub req { shift->tx->req }
-sub res { shift->tx->res }
-
-# Why am I sticky and naked? Did I miss something fun?
-sub session {
- my $self = shift;
-
- # Get
- my $stash = $self->stash;
- my $session = $stash->{'mojo.session'};
- if ($_[0] && !defined $_[1] && !ref $_[0]) {
- return unless $session && ref $session eq 'HASH';
- return $session->{$_[0]};
- }
-
- # Initialize
- $session = {} unless $session && ref $session eq 'HASH';
- $stash->{'mojo.session'} = $session;
-
- # Hash
- return $session unless @_;
-
- # Set
- my $values = exists $_[1] ? {@_} : $_[0];
- $stash->{'mojo.session'} = {%$session, %$values};
-
- return $self;
-}
-
-sub signed_cookie {
- my ($self, $name, $value, $options) = @_;
-
- # Shortcut
- return unless $name;
-
- # Secret
- my $secret = $self->app->secret;
-
- # Response cookie
- if (defined $value) {
-
- # Sign value
- my $signature = hmac_md5_sum $value, $secret;
- $value = $value .= "--$signature";
-
- # Create cookie
- my $cookie = $self->cookie($name, $value, $options);
- return $cookie;
- }
-
- # Request cookies
- my @values = $self->cookie($name);
- my @results;
- for my $value (@values) {
-
- # Check signature
- if ($value =~ s/\-\-([^\-]+)$//) {
- my $signature = $1;
- my $check = hmac_md5_sum $value, $secret;
-
- # Verified
- if ($signature eq $check) { push @results, $value }
-
- # Bad cookie
- else {
- $self->app->log->debug(
- qq/Bad signed cookie "$name", possible hacking attempt./);
- }
- }
-
- # Not signed
- else { $self->app->log->debug(qq/Cookie "$name" not signed./) }
- }
-
- return wantarray ? @results : $results[0];
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Session::Cookie::Controller - Controller Base Class
-
-=head1 SYNOPSIS
-
- use base 'MojoX::Session::Cookie::Controller';
-
-=head1 DESCRIPTION
-
-L<MojoX::Session::Cookie::Controller> is a controller base class.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Session::Cookie::Controller> inherits all attributes from
-L<MojoX::Controller> and implements the following new ones.
-
-=head2 C<tx>
-
- my $tx = $c->tx;
-
-The transaction that is currently being processed, defaults to a
-L<Mojo::Transaction::HTTP> object.
-
-=head1 METHODS
-
-L<MojoX::Session::Cookie::Controller> inherits all methods from
-L<MojoX::Controller> and implements the following ones.
-
-=head2 C<cookie>
-
- $c = $c->cookie(foo => 'bar');
- $c = $c->cookie(foo => 'bar', {path => '/'});
- my $value = $c->cookie('foo');
- my @values = $c->cookie('foo');
-
-Access request cookie values and create new response cookies.
-
-=head2 C<flash>
-
- my $flash = $c->flash;
- my $foo = $c->flash('foo');
- $c = $c->flash({foo => 'bar'});
- $c = $c->flash(foo => 'bar');
-
-Data storage persistent for the next request, stored in the session.
-
- $c->flash->{foo} = 'bar';
- my $foo = $c->flash->{foo};
- delete $c->flash->{foo};
-
-=head2 C<req>
-
- my $req = $c->req;
-
-Alias for C<$c->tx->req>.
-Usually refers to a L<Mojo::Message::Request> object.
-
-=head2 C<res>
-
- my $res = $c->res;
-
-Alias for C<$c->tx->res>.
-Usually refers to a L<Mojo::Message::Response> object.
-
-=head2 C<session>
-
- my $session = $c->session;
- my $foo = $c->session('foo');
- $c = $c->session({foo => 'bar'});
- $c = $c->session(foo => 'bar');
-
-Persistent data storage, by default stored in a signed cookie.
-Note that cookies are generally limited to 4096 bytes of data.
-
- $c->session->{foo} = 'bar';
- my $foo = $c->session->{foo};
- delete $c->session->{foo};
-
-=head2 C<signed_cookie>
-
- $c = $c->signed_cookie(foo => 'bar');
- $c = $c->signed_cookie(foo => 'bar', {path => '/'});
- my $value = $c->signed_cookie('foo');
- my @values = $c->signed_cookie('foo');
-
-Access signed request cookie values and create new signed response cookies.
-Cookies failing signature verification will be automatically discarded.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,163 +0,0 @@
-package MojoX::Session::Cookie;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use Mojo::Util qw/b64_decode b64_encode/;
-use Storable qw/freeze thaw/;
-
-__PACKAGE__->attr('cookie_domain');
-__PACKAGE__->attr(cookie_name => 'mojolicious');
-__PACKAGE__->attr(cookie_path => '/');
-__PACKAGE__->attr(default_expiration => 3600);
-
-# Bender, quit destroying the universe!
-sub load {
- my ($self, $c) = @_;
-
- # Session cookie
- return unless my $value = $c->signed_cookie($self->cookie_name);
-
- # Decode
- b64_decode $value;
-
- # Thaw
- my $session = thaw $value;
-
- # Expiration
- return unless my $expires = delete $session->{expires};
- return unless $expires > time;
-
- # Content
- my $stash = $c->stash;
- return unless $stash->{'mojo.active_session'} = keys %$session;
- $stash->{'mojo.session'} = $session;
-
- # Flash
- $session->{old_flash} = delete $session->{flash} if $session->{flash};
-}
-
-# Emotions are dumb and should be hated.
-sub store {
- my ($self, $c) = @_;
-
- # Session
- my $stash = $c->stash;
- return unless my $session = $stash->{'mojo.session'};
- return unless keys %$session || $stash->{'mojo.active_session'};
-
- # Flash
- delete $session->{old_flash};
- delete $session->{flash} unless keys %{$session->{flash}};
-
- # Default to expiring session
- my $expires = 1;
- my $value = '';
-
- # Actual session data
- my $default = delete $session->{expires};
- if (keys %$session) {
-
- # Expiration
- $expires = $session->{expires} = $default
- ||= time + $self->default_expiration;
-
- # Freeze
- $value = freeze $session;
-
- # Encode
- b64_encode $value, '';
- }
-
- # Options
- my $options = {expires => $expires, path => $self->cookie_path};
- my $domain = $self->cookie_domain;
- $options->{domain} = $domain if $domain;
-
- # Session cookie
- $c->signed_cookie($self->cookie_name, $value, $options);
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Session::Cookie - Signed Cookie Based Sessions
-
-=head1 SYNOPSIS
-
- use MojoX::Session::Cookie;
- use MojoX::Session::Cookie::Controller;
-
- my $session = MojoX::Session::Cookie->new;
- my $c = MojoX::Session::Cookie::Controller->new;
- $session->load($c);
- $c->session(foo => 'bar');
- $session->store($c);
-
-=head1 DESCRIPTION
-
-L<MojoX::Session::Cookie> is a very simple signed cookie based session
-implementation.
-All data gets stored on the client side, but is protected from unwanted
-changes with a signature.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Session::Cookie> implements the following attributes.
-
-=head2 C<cookie_domain>
-
- my $domain = $session->cookie_domain;
- $session = $session->cookie_domain('.example.com');
-
-Domain for session cookie, not defined by default.
-
-=head2 C<cookie_name>
-
- my $name = $session->cookie_name;
- $session = $session->cookie_name('session');
-
-Name of the signed cookie used to store session data, defaults to
-C<mojolicious>.
-
-=head2 C<cookie_path>
-
- my $path = $session->cookie_path;
- $session = $session->cookie_path('/foo');
-
-Path for session cookie, defaults to C</>.
-
-=head2 C<default_expiration>
-
- my $time = $session->default_expiration;
- $session = $session->default_expiration(3600);
-
-Time for the session to expire in seconds from now, defaults to C<3600>.
-The expiration timeout gets refreshed for every request.
-
-=head1 METHODS
-
-L<MojoX::Session::Cookie> inherits all methods from L<Mojo::Base> and
-implements the following ones.
-
-=head2 C<load>
-
- $session->load($c);
-
-Load session data from signed cookie.
-
-=head2 C<store>
-
- $session->store($c);
-
-Store session data in signed cookie.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,101 +0,0 @@
-package MojoX::Types;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-# Once again, the conservative, sandwich-heavy portfolio pays off for the
-# hungry investor.
-__PACKAGE__->attr(
- types => sub {
- return {
- atom => 'application/atom+xml',
- bin => 'application/octet-stream',
- css => 'text/css',
- gif => 'image/gif',
- gz => 'application/gzip',
- htm => 'text/html',
- html => 'text/html',
- ico => 'image/x-icon',
- jpeg => 'image/jpeg',
- jpg => 'image/jpeg',
- js => 'application/x-javascript',
- json => 'application/json',
- mp3 => 'audio/mpeg',
- png => 'image/png',
- rss => 'application/rss+xml',
- svg => 'image/svg+xml',
- tar => 'application/x-tar',
- txt => 'text/plain',
- xml => 'text/xml',
- zip => 'application/zip'
- };
- }
-);
-
-# Magic. Got it.
-sub type {
- my ($self, $ext, $type) = @_;
-
- # Set
- if ($type) {
- $self->types->{$ext} = $type;
- return $self;
- }
-
- return $self->types->{$ext || ''};
-}
-
-1;
-__END__
-
-=head1 NAME
-
-MojoX::Types - MIME Types
-
-=head1 SYNOPSIS
-
- use MojoX::Types;
-
- # New type list
- my $types = MojoX::Types->new;
-
- # Get MIME type for ".png"
- my $type = $types->type('png');
-
- # Add MIME type for ".foo"
- $types->type(foo => 'mojo/foo');
-
-=head1 DESCRIPTION
-
-L<MojoX::Types> is a container for MIME types.
-
-=head1 ATTRIBUTES
-
-L<MojoX::Types> implements the following attributes.
-
-=head2 C<types>
-
- my $map = $types->types;
- $types = $types->types({png => 'image/png'});
-
-List of MIME types.
-
-=head1 METHODS
-
-L<MojoX::Types> inherits all methods from L<Mojo::Base> and implements the
-following ones.
-
-=head2 C<type>
-
- my $type = $types->type('png');
- $types = $types->type(png => 'image/png');
-
-Get or set MIME type for file extension.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -0,0 +1,89 @@
+package Mojolicious::Command::Cgi;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Mojo::Server::CGI;
+
+use Getopt::Long 'GetOptions';
+
+__PACKAGE__->attr(description => <<'EOF');
+Start application with CGI.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 cgi [OPTIONS]
+
+These options are available:
+ --nph Enable non-parsed-header mode.
+EOF
+
+# Hi, Super Nintendo Chalmers!
+sub run {
+ my $self = shift;
+ my $cgi = Mojo::Server::CGI->new;
+
+ # Options
+ local @ARGV = @_ if @_;
+ GetOptions(nph => sub { $cgi->nph(1) });
+
+ # Run
+ $cgi->run;
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Cgi - CGI Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::CGI;
+
+ my $cgi = Mojolicious::Command::CGI->new;
+ $cgi->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Cgi> is a command interface to L<Mojo::Server::CGI>.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Cgi> inherits all attributes from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $cgi->description;
+ $cgi = $cgi->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $cgi->usage;
+ $cgi = $cgi->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Cgi> inherits all methods from L<Mojo::Command> and
+implements the following new ones.
+
+=head2 C<run>
+
+ $cgi = $cgi->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,119 @@
+package Mojolicious::Command::Daemon;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Mojo::Server::Daemon;
+
+use Getopt::Long 'GetOptions';
+
+__PACKAGE__->attr(description => <<'EOF');
+Start application with HTTP 1.1 and WebSocket server.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 daemon [OPTIONS]
+
+These options are available:
+ --backlog <size> Set listen backlog size, defaults to SOMAXCONN.
+ --clients <number> Set maximum number of concurrent clients, defaults
+ to 1000.
+ --group <name> Set group name for process.
+ --keepalive <seconds> Set keep-alive timeout, defaults to 15.
+ --listen <location> Set one or more locations you want to listen on,
+ defaults to http://*:3000.
+ --proxy Activate reverse proxy support, defaults to the
+ value of MOJO_REVERSE_PROXY.
+ --reload Automatically reload application when the source
+ code changes.
+ --requests <number> Set maximum number of requests per keep-alive
+ connection, defaults to 100.
+ --user <name> Set user name for process.
+ --websocket <seconds> Set WebSocket timeout, defaults to 300.
+EOF
+
+
+# This is the worst thing you've ever done.
+# You say that so often that it lost its meaning.
+sub run {
+ my $self = shift;
+ my $daemon = Mojo::Server::Daemon->new;
+
+ # Options
+ local @ARGV = @_ if @_;
+ my @listen;
+ GetOptions(
+ 'backlog=i' => sub { $daemon->backlog($_[1]) },
+ 'clients=i' => sub { $daemon->max_clients($_[1]) },
+ 'group=s' => sub { $daemon->group($_[1]) },
+ 'keepalive=i' => sub { $daemon->keep_alive_timeout($_[1]) },
+ 'listen=s' => \@listen,
+ 'proxy' => sub { $ENV{MOJO_REVERSE_PROXY} = 1 },
+ reload => sub { $ENV{MOJO_RELOAD} = 1 },
+ 'requests=i' => sub { $daemon->max_requests($_[1]) },
+ 'user=s' => sub { $daemon->user($_[1]) },
+ 'websocket=i' => sub { $daemon->websocket_timeout($_[1]) }
+ );
+ $daemon->listen(\@listen) if @listen;
+
+ # Run
+ $daemon->run;
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Daemon - Daemon Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Daemon;
+
+ my $daemon = Mojolicious::Command::Daemon->new;
+ $daemon->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Daemon> is a command interface to
+L<Mojo::Server::Daemon>.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Daemon> inherits all attributes from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $daemon->description;
+ $daemon = $daemon->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $daemon->usage;
+ $daemon = $daemon->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Daemon> inherits all methods from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<run>
+
+ $daemon = $daemon->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,81 @@
+package Mojolicious::Command::Fastcgi;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Mojo::Server::FastCGI;
+
+__PACKAGE__->attr(description => <<'EOF');
+Start application with FastCGI.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 fastcgi
+EOF
+
+# Oh boy! Sleep! That's when I'm a Viking!
+sub run {
+ my $self = shift;
+ my $fastcgi = Mojo::Server::FastCGI->new;
+
+ # Run
+ $fastcgi->run;
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Fastcgi - FastCGI Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Fastcgi;
+
+ my $fastcgi = Mojolicious::Command::Fastcgi->new;
+ $fastcgi->run;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Fastcgi> is a command interface to
+L<Mojo::Server::FastCGI>.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::FastCGI> inherits all attributes from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $fastcgi->description;
+ $fastcgi = $fastcgi->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $fastcgi->usage;
+ $fastcgi = $fastcgi->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Fastcgi> inherits all methods from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<run>
+
+ $fastcgi = $fastcgi->run;
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -45,10 +45,6 @@ sub run {
$self->renderer->line_start('%%');
$self->renderer->tag_start('<%%');
$self->renderer->tag_end('%%>');
- $self->render_to_rel_file('not_found',
- "$name/templates/not_found.html.ep");
- $self->render_to_rel_file('exception',
- "$name/templates/exception.html.ep");
$self->render_to_rel_file('layout',
"$name/templates/layouts/default.html.ep");
$self->render_to_rel_file('welcome',
@@ -147,59 +143,6 @@ use_ok('<%= $class %>');
my $t = Test::Mojo->new(app => '<%= $class %>');
$t->get_ok('/')->status_is(200)->content_type_is('text/html')
->content_like(qr/Mojolicious Web Framework/i);
-@@ not_found
-<!doctype html><html>
- <head><title>Not Found</title></head>
- <body>
- The page you were requesting
- "<%= $self->req->url->path || '/' %>"
- could not be found.
- </body>
-</html>
-@@ exception
-% my $e = delete $self->stash->{'exception'};
-<!doctype html><html>
- <head>
- <title>Exception</title>
- <style type="text/css">
- body {
- font: 0.9em Verdana, "Bitstream Vera Sans", sans-serif;
- }
- .snippet {
- font: 115% Monaco, "Courier New", monospace;
- }
- </style>
- </head>
- <body>
- <% if ($self->app->mode eq 'development') { %>
- <div>
- This page was generated from the template
- "templates/exception.html.ep".
- </div>
- <div class="snippet"><pre><%= $e->message %></pre></div>
- <div>
- <% for my $line (@{$e->lines_before}) { %>
- <div class="snippet">
- <%= $line->[0] %>: <%= $line->[1] %>
- </div>
- <% } %>
- <% if ($e->line->[0]) { %>
- <div class="snippet">
- <b><%= $e->line->[0] %>: <%= $e->line->[1] %></b>
- </div>
- <% } %>
- <% for my $line (@{$e->lines_after}) { %>
- <div class="snippet">
- <%= $line->[0] %>: <%= $line->[1] %>
- </div>
- <% } %>
- </div>
- <div class="snippet"><pre><%= dumper $self->stash %></pre></div>
- <% } else { %>
- <div>Page temporarily unavailable, please come back later.</div>
- <% } %>
- </body>
-</html>
@@ layout
<!doctype html><html>
<head><title>Welcome</title></head>
@@ -0,0 +1,83 @@
+package Mojolicious::Command::Generate::Hypnotoad;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+# As a scientist,
+# I can assure you that we did in fact evolve from filthy monkey-men.
+__PACKAGE__->attr(description => <<'EOF');
+Generate hypnotoad.conf.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 generate hypnotoad
+EOF
+
+# Oh no! Can we switch back using four or more bodies?
+# I'm not sure. I'm afraid we need to use... MATH.
+sub run {
+ my $self = shift;
+ $self->render_to_rel_file('hypnotoad', 'hypnotoad.conf');
+ $self->chmod_file('hypnotoad.conf', 0644);
+}
+
+1;
+__DATA__
+@@ hypnotoad
+{
+ listen => ['http://*:8080'],
+ workers => 4
+};
+__END__
+=head1 NAME
+
+Mojolicious::Command::Generate::Hypnotoad - Hypnotoad Generator Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Generate::Hypnotoad;
+
+ my $hypnotoad = Mojolicious::Command::Generate::Hypnotoad->new;
+ $hypnotoad->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Generate::Hypnotoad> is a C<hypnotoad.conf>
+generator.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Generate::Hypnotoad> inherits all attributes from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $hypnotoad->description;
+ $hypnotoad = $hypnotoad->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $hypnotoad->usage;
+ $hypnotoad = $hypnotoad->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Generate::Hypnotoad> inherits all methods from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<run>
+
+ $hypnotoad = $hypnotoad->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -3,7 +3,7 @@ package Mojolicious::Command::Generate;
use strict;
use warnings;
-use base 'Mojo::Commands';
+use base 'Mojolicious::Commands';
__PACKAGE__->attr(description => <<'EOF');
Generate files and directories from templates.
@@ -46,7 +46,7 @@ L<Mojolicious::Command::Generate> lists available generators.
=head1 ATTRIBUTES
L<Mojolicious::Command::Generate> inherits all attributes from
-L<Mojo::Commands> and implements the following new ones.
+L<Mojolicious::Commands> and implements the following new ones.
=head2 C<description>
@@ -80,7 +80,7 @@ L<Mojo::Command::Generate> and L<Mojolicious::Command::Generate>.
=head1 METHODS
L<Mojolicious::Command::Generate> inherits all methods from
-L<Mojo::Commands>.
+L<Mojolicious::Commands>.
=head1 SEE ALSO
@@ -0,0 +1,123 @@
+package Mojolicious::Command::Get;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Mojo::Client;
+use Mojo::IOLoop;
+use Mojo::Transaction::HTTP;
+use Mojo::Util 'decode';
+
+use Getopt::Long 'GetOptions';
+
+__PACKAGE__->attr(description => <<'EOF');
+Get file from URL.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 get [OPTIONS] [URL]
+
+These options are available:
+ --verbose Print response start line and headers to STDERR.
+EOF
+
+# I hope this has taught you kids a lesson: kids never learn.
+sub run {
+ my $self = shift;
+
+ # Options
+ local @ARGV = @_ if @_;
+ my $verbose = 0;
+ GetOptions('verbose' => sub { $verbose = 1 });
+
+ # URL
+ my $url = $ARGV[0];
+ die $self->usage unless $url;
+ decode 'UTF-8', $url;
+
+ # Client
+ my $client = Mojo::Client->new(ioloop => Mojo::IOLoop->singleton);
+
+ # Silence
+ $client->log->level('fatal');
+
+ # Application
+ $client->app($ENV{MOJO_APP} || 'Mojo::HelloWorld')
+ unless $url =~ /^\w+:\/\//;
+
+ # Transaction
+ my $tx = $client->build_tx(GET => $url);
+ $tx->res->body(
+ sub {
+ my ($res, $chunk) = @_;
+ warn $tx->res->build_start_line if $verbose;
+ warn $res->headers->to_string, "\n\n" if $verbose;
+ $verbose = 0;
+ print $chunk;
+ }
+ );
+
+ # Request
+ $client->start($tx);
+
+ # Error
+ my ($message, $code) = $tx->error;
+ warn qq/Problem loading URL "$url". ($message)\n/ if $message && !$code;
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Get - Get Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Get;
+
+ my $get = Mojolicious::Command::Get->new;
+ $get->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Get> is a command interface to L<Mojo::Client>.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Get> inherits all attributes from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $get->description;
+ $get = $get->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $get->usage;
+ $get = $get->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Get> inherits all methods from L<Mojo::Command> and
+implements the following new ones.
+
+=head2 C<run>
+
+ $get = $get->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -13,6 +13,8 @@ Inflate embedded files to real files.
EOF
__PACKAGE__->attr(usage => <<"EOF");
usage: $0 inflate [OPTIONS]
+
+These options are available:
--class <class> Class to inflate.
--public <path> Path prefix for generated static files, defaults to
public.
@@ -44,9 +46,11 @@ sub run {
# Generate
my $all = $self->get_all_data($class);
for my $file (keys %$all) {
- my $prefix = $file =~ /\.\w+\.\w+$/ ? $templates : $public;
- my $path = $self->rel_file("$prefix/$file");
- $self->write_file($path, $all->{$file});
+ my $prefix = $file =~ /\.\w+\.\w+$/ ? $templates : $public;
+ my $path = $self->rel_file("$prefix/$file");
+ my $content = $all->{$file};
+ utf8::encode $content if utf8::is_utf8 $content;
+ $self->write_file($path, $content);
}
return $self;
@@ -0,0 +1,85 @@
+package Mojolicious::Command::Psgi;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Mojo::Server::PSGI;
+
+# Don't let Krusty's death get you down, boy.
+# People die all the time, just like that.
+# Why, you could wake up dead tomorrow! Well, good night.
+__PACKAGE__->attr(description => <<'EOF');
+Start application with PSGI.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 psgi
+EOF
+
+# D’oh.
+sub run {
+ my $self = shift;
+ my $psgi = Mojo::Server::PSGI->new;
+
+ # Preload
+ $psgi->app;
+
+ # Return app callback
+ return sub { $psgi->run(@_) };
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Psgi - PSGI Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Psgi;
+
+ my $psgi = Mojolicious::Command::Psgi->new;
+ my $app = $psgi->run;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Psgi> is a command interface to
+L<Mojo::Server::PSGI>.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Psgi> inherits all attributes from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $psgi->description;
+ $psgi = $psgi->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $psgi->usage;
+ $psgi = $psgi->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Psgi> inherits all methods from L<Mojo::Command> and
+implements the following new ones.
+
+=head2 C<run>
+
+ my $app = $psgi->run;
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,122 @@
+package Mojolicious::Command::Test;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Cwd;
+use FindBin;
+use File::Spec;
+use Test::Harness;
+
+# Okay folks, show's over. Nothing to see here, show's... Oh my god!
+# A horrible plane crash! Hey everybody, get a load of this flaming wreckage!
+# Come on, crowd around, crowd around!
+__PACKAGE__->attr(description => <<'EOF');
+Run unit tests.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 test [TESTS]
+EOF
+
+# My eyes! The goggles do nothing!
+sub run {
+ my ($self, @tests) = @_;
+
+ # Search tests
+ unless (@tests) {
+ my @base = File::Spec->splitdir(File::Spec->abs2rel($FindBin::Bin));
+
+ # Test directory in the same directory as "mojo" (t)
+ my $path = File::Spec->catdir(@base, 't');
+
+ # Test dirctory in the directory above "mojo" (../t)
+ $path = File::Spec->catdir(@base, '..', 't') unless -d $path;
+ unless (-d $path) {
+ print "Can't find test directory.\n";
+ return;
+ }
+
+ # List test files
+ my @dirs = ($path);
+ while (my $dir = shift @dirs) {
+ opendir(my $fh, $dir);
+ for my $file (readdir($fh)) {
+ next if $file eq '.';
+ next if $file eq '..';
+ my $fpath = File::Spec->catfile($dir, $file);
+ push @dirs, File::Spec->catdir($dir, $file) if -d $fpath;
+ push @tests,
+ File::Spec->abs2rel(
+ Cwd::realpath(
+ File::Spec->catfile(File::Spec->splitdir($fpath))
+ )
+ ) if (-f $fpath) && ($fpath =~ /\.t$/);
+ }
+ closedir $fh;
+ }
+
+ $path = Cwd::realpath($path);
+ print "Running tests from '$path'.\n";
+ }
+
+ # Run tests
+ runtests(@tests);
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Test - Test Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Test;
+
+ my $test = Mojolicious::Command::Test->new;
+ $test->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Test> is a test script.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Test> inherits all attributes from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $test->description;
+ $test = $test->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $test->usage;
+ $test = $test->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Test> inherits all methods from L<Mojo::Command> and
+implements the following new ones.
+
+=head2 C<run>
+
+ $test = $test->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,130 @@
+package Mojolicious::Command::Version;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+use Mojo::Client;
+use Mojo::IOLoop;
+use Mojo::Server::Daemon;
+use Mojolicious;
+
+__PACKAGE__->attr(description => <<'EOF');
+Show versions of installed modules.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 version
+
+EOF
+
+# If at first you don't succeed, give up.
+sub run {
+ my $self = shift;
+
+ # Mojo
+ my $mojo = $Mojolicious::VERSION;
+ my $codename = $Mojolicious::CODENAME;
+
+ # Latest version
+ my $latest = $mojo;
+ eval {
+ Mojo::Client->new->max_redirects(3)
+ ->get('search.cpan.org/dist/Mojolicious')->res->dom('.version')
+ ->each(sub { $latest = $_->text if $_->text =~ /^[\d\.]+$/ });
+ };
+
+ # Message
+ my $message = 'This version is up to date, have fun!';
+ $message = 'Thanks for testing a development release, you are awesome!'
+ if $latest < $mojo;
+ $message = "You might want to update your Mojolicious to $latest."
+ if $latest > $mojo;
+
+ # Epoll
+ my $epoll = Mojo::IOLoop::EPOLL() ? $IO::Epoll::VERSION : 'not installed';
+
+ # KQueue
+ my $kqueue =
+ Mojo::IOLoop::KQUEUE() ? $IO::KQueue::VERSION : 'not installed';
+
+ # TLS
+ my $tls =
+ Mojo::IOLoop::TLS() ? $IO::Socket::SSL::VERSION : 'not installed';
+
+ # Bonjour
+ my $bonjour =
+ eval 'Mojo::Server::Daemon::BONJOUR()'
+ ? $Net::Rendezvous::Publish::VERSION
+ : 'not installed';
+
+ print <<"EOF";
+CORE
+ Perl ($], $^O)
+ Mojolicious ($mojo, $codename)
+
+OPTIONAL
+ IO::Epoll ($epoll)
+ IO::KQueue ($kqueue)
+ IO::Socket::SSL ($tls)
+ Net::Rendezvous::Publish ($bonjour)
+
+$message
+EOF
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Command::Version - Version Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Version;
+
+ my $v = Mojolicious::Command::Version->new;
+ $v->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Version> shows versions of installed modules.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Version> inherits all attributes from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $v->description;
+ $v = $v->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $v->usage;
+ $v = $v->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Version> inherits all methods from L<Mojo::Command>
+and implements the following new ones.
+
+=head2 C<run>
+
+ $get = $v->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -3,12 +3,12 @@ package Mojolicious::Commands;
use strict;
use warnings;
-use base 'Mojo::Commands';
+use base 'Mojo::Command';
-# One day a man has everything, the next day he blows up a $400 billion
-# space station, and the next day he has nothing. It makes you think.
use Getopt::Long qw/GetOptions :config pass_through/;
+# One day a man has everything, the next day he blows up a $400 billion
+# space station, and the next day he has nothing. It makes you think.
__PACKAGE__->attr(hint => <<"EOF");
These options are available for all commands:
@@ -27,7 +27,7 @@ BEGIN {
GetOptions(
'home=s' => sub { $ENV{MOJO_HOME} = $_[1] },
'mode=s' => sub { $ENV{MOJO_MODE} = $_[1] }
- ) unless Mojo::Commands->detect;
+ ) unless Mojo::Command->detect;
}
1;
@@ -39,7 +39,7 @@ Mojolicious::Commands - Commands
=head1 SYNOPSIS
- use Mojo::Commands;
+ use Mojolicious::Commands;
# Command line interface
my $commands = Mojolicious::Commands->new;
@@ -52,11 +52,42 @@ L<Mojolicious> framework.
It will automatically detect available commands in the
L<Mojolicious::Command> namespace.
-These commands are available by default in addition to the commands listed in
-L<Mojo::Commands>.
+These commands are available by default.
=over 4
+=item C<help>
+
+ mojo
+ mojo help
+
+List available commands with short descriptions.
+
+ mojo help <command>
+
+List available options for the command with short descriptions.
+
+=item C<cgi>
+
+ mojo cgi
+ script/myapp cgi
+
+Start application with CGI backend.
+
+=item C<daemon>
+
+ mojo daemon
+ script/myapp daemon
+
+Start application with standalone HTTP 1.1 server backend.
+
+=item C<fastcgi>
+
+ mojo fastcgi
+ script/myapp fastcgi
+
+Start application with FastCGI backend.
+
=item C<generate>
mojo generate
@@ -87,6 +118,13 @@ Generate a fully functional L<Mojolicious::Lite> application.
Generate C<Makefile.PL> file for application.
+=item C<get>
+
+ mojo get http://mojolicious.org
+ script/myapp get /foo
+
+Perform GET request to remote host or local application.
+
=item C<inflate>
myapp.pl inflate
@@ -100,11 +138,26 @@ Turn embedded files from the C<DATA> section into real files.
List application routes.
+=item C<test>
+
+ mojo test
+ script/myapp test
+ script/myapp test t/foo.t
+
+Runs application tests from the C<t> directory.
+
+=item C<version>
+
+ mojo version
+
+List version information for installed core and optional modules, very useful
+for debugging.
+
=back
=head1 ATTRIBUTES
-L<Mojolicious::Commands> inherits all attributes from L<Mojo::Commands> and
+L<Mojolicious::Commands> inherits all attributes from L<Mojo::Command> and
implements the following new ones.
=head2 C<hint>
@@ -124,7 +177,7 @@ L<Mojolicious::Command>.
=head1 METHODS
-L<Mojolicious::Commands> inherits all methods from L<Mojo::Commands>.
+L<Mojolicious::Commands> inherits all methods from L<Mojo::Command>.
=head1 SEE ALSO
@@ -3,19 +3,131 @@ package Mojolicious::Controller;
use strict;
use warnings;
-use base 'MojoX::Dispatcher::Routes::Controller';
+use base 'Mojo::Base';
use Mojo::ByteStream;
+use Mojo::Cookie::Response;
use Mojo::Exception;
+use Mojo::Transaction::HTTP;
use Mojo::URL;
+use Mojo::Util;
require Carp;
+# Scalpel... blood bucket... priest.
+__PACKAGE__->attr([qw/app match/]);
+__PACKAGE__->attr(tx => sub { Mojo::Transaction::HTTP->new });
+
# DEPRECATED in Comet!
*finished = \&on_finish;
*receive_message = \&on_message;
-our $AUTOLOAD;
+# Exception template
+our $EXCEPTION = <<'EOF';
+% my $e = delete $self->stash->{'exception'};
+<!doctype html><html>
+ <head>
+ <title>Exception</title>
+ <style type="text/css">
+ body {
+ font: 0.9em Verdana, "Bitstream Vera Sans", sans-serif;
+ }
+ .snippet {
+ font: 115% Monaco, "Courier New", monospace;
+ }
+ </style>
+ </head>
+ <body>
+ <% if ($self->app->mode eq 'development') { %>
+ <div class="snippet"><pre><%= $e->message %></pre></div>
+ <div>
+ <% for my $line (@{$e->lines_before}) { %>
+ <div class="snippet">
+ <%= $line->[0] %>: <%= $line->[1] %>
+ </div>
+ <% } %>
+ <% if ($e->line->[0]) { %>
+ <div class="snippet">
+ <b><%= $e->line->[0] %>: <%= $e->line->[1] %></b>
+ </div>
+ <% } %>
+ <% for my $line (@{$e->lines_after}) { %>
+ <div class="snippet">
+ <%= $line->[0] %>: <%= $line->[1] %>
+ </div>
+ <% } %>
+ </div>
+ <div class="snippet"><pre><%= dumper $self->stash %></pre></div>
+ <% } else { %>
+ <div>Page temporarily unavailable, please come back later.</div>
+ <% } %>
+ </body>
+</html>
+EOF
+
+# Not found template
+our $NOT_FOUND = <<'EOF';
+<!doctype html><html>
+ <head>
+ <title>Not Found</title>
+ <style type="text/css">
+ body {
+ font: 0.9em Verdana, "Bitstream Vera Sans", sans-serif;
+ }
+ </style>
+ </head>
+ <body>
+ <div>
+ Page not found, want to go <%= link_to home => url_for->base %>?
+ </div>
+ </body>
+</html>
+EOF
+
+# Reserved stash values
+my $STASH_RE = qr/
+ ^
+ (?:
+ action
+ |
+ app
+ |
+ cb
+ |
+ class
+ |
+ controller
+ |
+ data
+ |
+ exception
+ |
+ extends
+ |
+ format
+ |
+ handler
+ |
+ json
+ |
+ layout
+ |
+ method
+ |
+ namespace
+ |
+ partial
+ |
+ path
+ |
+ status
+ |
+ template
+ |
+ text
+ )
+ $
+ /x;
# Is all the work done by the children?
# No, not the whipping.
@@ -23,7 +135,7 @@ sub AUTOLOAD {
my $self = shift;
# Method
- my ($package, $method) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
+ my ($package, $method) = our $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
# Helper
Carp::croak(qq/Can't locate object method "$method" via "$package"/)
@@ -37,6 +149,44 @@ sub DESTROY { }
sub client { shift->app->client }
+# For the last time, I don't like lilacs!
+# Your first wife was the one who liked lilacs!
+# She also liked to shut up!
+sub cookie {
+ my ($self, $name, $value, $options) = @_;
+
+ # Shortcut
+ return unless $name;
+
+ # Response cookie
+ if (defined $value) {
+
+ # Cookie too big
+ $self->app->log->error(qq/Cookie "$name" is bigger than 4096 bytes./)
+ if length $value > 4096;
+
+ # Create new cookie
+ $options ||= {};
+ my $cookie = Mojo::Cookie::Response->new(
+ name => $name,
+ value => $value,
+ %$options
+ );
+ $self->res->cookies($cookie);
+ return $self;
+ }
+
+ # Request cookie
+ unless (wantarray) {
+ return unless my $cookie = $self->req->cookie($name);
+ return $cookie->value;
+ }
+
+ # Request cookies
+ my @cookies = $self->req->cookie($name);
+ return map { $_->value } @cookies;
+}
+
# Something's wrong, she's not responding to my poking stick.
sub finish {
my $self = shift;
@@ -51,6 +201,35 @@ sub finish {
$tx->finish;
}
+# You two make me ashamed to call myself an idiot.
+sub flash {
+ my $self = shift;
+
+ # Get
+ my $session = $self->stash->{'mojo.session'};
+ if ($_[0] && !defined $_[1] && !ref $_[0]) {
+ return unless $session && ref $session eq 'HASH';
+ return unless my $flash = $session->{old_flash};
+ return unless ref $flash eq 'HASH';
+ return $flash->{$_[0]};
+ }
+
+ # Initialize
+ $session = $self->session;
+ my $flash = $session->{flash};
+ $flash = {} unless $flash && ref $flash eq 'HASH';
+ $session->{flash} = $flash;
+
+ # Hash
+ return $flash unless @_;
+
+ # Set
+ my $values = exists $_[1] ? {@_} : $_[0];
+ $session->{flash} = {%$flash, %$values};
+
+ return $self;
+}
+
# DEPRECATED in Comet!
sub helper {
my $self = shift;
@@ -95,6 +274,34 @@ sub on_message {
return $self;
}
+# Just make a simple cake. And this time, if someone's going to jump out of
+# it make sure to put them in *after* you cook it.
+sub param {
+ my $self = shift;
+ my $name = shift;
+
+ # Captures
+ my $p = $self->stash->{'mojo.captures'} || {};
+
+ # List
+ unless (defined $name) {
+ my %seen;
+ return sort grep { !$seen{$_}++ } keys %$p, $self->req->param;
+ }
+
+ # Override value
+ if (@_) {
+ $p->{$name} = $_[0];
+ return $self;
+ }
+
+ # Captured value
+ return $p->{$name} if exists $p->{$name};
+
+ # Param value
+ return $self->req->param($name);
+}
+
# Is there an app for kissing my shiny metal ass?
# Several!
# Oooh!
@@ -146,8 +353,8 @@ sub render {
}
# Try the route name if we don't have controller and action
- elsif ($self->match && (my $name = $self->match->endpoint->name)) {
- $self->stash->{template} = $name;
+ elsif ($self->match && $self->match->endpoint) {
+ $self->stash->{template} = $self->match->endpoint->name;
}
}
@@ -168,7 +375,7 @@ sub render {
$res->code(200) unless $res->code;
# Output
- $res->body($output) unless $res->body;
+ $res->body($output);
# Type
my $headers = $res->headers;
@@ -205,7 +412,10 @@ sub render_exception {
# Error
$self->app->log->error($e);
- # Render exception template
+ # Recursion
+ return if $self->stash->{'mojo.exception'};
+
+ # Exception template
my $options = {
template => 'exception',
format => 'html',
@@ -214,8 +424,18 @@ sub render_exception {
exception => $e,
'mojo.exception' => 1
};
- $self->app->static->serve_500($self)
- if $self->stash->{'mojo.exception'} || !$self->render($options);
+
+ # Inline template
+ unless ($self->render($options)) {
+ $self->render(
+ inline => $EXCEPTION,
+ format => 'html',
+ handler => 'ep',
+ status => 500,
+ exception => $e,
+ 'mojo.exception' => 1
+ );
+ }
# Rendered
$self->rendered;
@@ -262,15 +482,33 @@ sub render_not_found {
$self->app->log->debug(qq/Resource "$resource" not found./)
if $resource;
+ # Stash
+ my $stash = $self->stash;
+
+ # Exception
+ return if $stash->{'mojo.exception'};
+
+ # Recursion
+ return if $stash->{'mojo.not_found'};
+
# Render not found template
my $options = {
- template => 'not_found',
- format => 'html',
- not_found => 1
+ template => 'not_found',
+ format => 'html',
+ status => 404,
+ 'mojo.not_found' => 1
};
- $options->{status} = 404 unless $self->stash->{status};
- $self->app->static->serve_404($self)
- if $self->stash->{not_found} || !$self->render($options);
+
+ # Inline template
+ unless ($self->render($options)) {
+ $self->render(
+ inline => $NOT_FOUND,
+ format => 'html',
+ handler => 'ep',
+ status => 404,
+ 'mojo.not_found' => 1
+ );
+ }
# Rendered
$self->rendered;
@@ -358,6 +596,9 @@ sub rendered {
return $self;
}
+sub req { shift->tx->req }
+sub res { shift->tx->res }
+
sub send_message {
my $self = shift;
@@ -377,6 +618,104 @@ sub send_message {
return $self;
}
+# Why am I sticky and naked? Did I miss something fun?
+sub session {
+ my $self = shift;
+
+ # Get
+ my $stash = $self->stash;
+ my $session = $stash->{'mojo.session'};
+ if ($_[0] && !defined $_[1] && !ref $_[0]) {
+ return unless $session && ref $session eq 'HASH';
+ return $session->{$_[0]};
+ }
+
+ # Initialize
+ $session = {} unless $session && ref $session eq 'HASH';
+ $stash->{'mojo.session'} = $session;
+
+ # Hash
+ return $session unless @_;
+
+ # Set
+ my $values = exists $_[1] ? {@_} : $_[0];
+ $stash->{'mojo.session'} = {%$session, %$values};
+
+ return $self;
+}
+
+sub signed_cookie {
+ my ($self, $name, $value, $options) = @_;
+
+ # Shortcut
+ return unless $name;
+
+ # Secret
+ my $secret = $self->app->secret;
+
+ # Response cookie
+ if (defined $value) {
+
+ # Sign value
+ my $signature = Mojo::Util::hmac_md5_sum $value, $secret;
+ $value = $value .= "--$signature";
+
+ # Create cookie
+ my $cookie = $self->cookie($name, $value, $options);
+ return $cookie;
+ }
+
+ # Request cookies
+ my @values = $self->cookie($name);
+ my @results;
+ for my $value (@values) {
+
+ # Check signature
+ if ($value =~ s/\-\-([^\-]+)$//) {
+ my $signature = $1;
+ my $check = Mojo::Util::hmac_md5_sum $value, $secret;
+
+ # Verified
+ if ($signature eq $check) { push @results, $value }
+
+ # Bad cookie
+ else {
+ $self->app->log->debug(
+ qq/Bad signed cookie "$name", possible hacking attempt./);
+ }
+ }
+
+ # Not signed
+ else { $self->app->log->debug(qq/Cookie "$name" not signed./) }
+ }
+
+ return wantarray ? @results : $results[0];
+}
+
+# All this knowledge is giving me a raging brainer.
+sub stash {
+ my $self = shift;
+
+ # Initialize
+ $self->{stash} ||= {};
+
+ # Hash
+ return $self->{stash} unless @_;
+
+ # Get
+ return $self->{stash}->{$_[0]} unless @_ > 1 || ref $_[0];
+
+ # Set
+ my $values = ref $_[0] ? $_[0] : {@_};
+ for my $key (keys %$values) {
+ $self->app->log->debug(qq/Careful, "$key" is a reserved stash value./)
+ if $key =~ $STASH_RE;
+ $self->{stash}->{$key} = $values->{$key};
+ }
+
+ return $self;
+}
+
# Behold, a time traveling machine.
# Time? I can't go back there!
# Ah, but this machine only goes forward in time.
@@ -388,7 +727,8 @@ sub url_for {
my $target = shift || '';
# Make sure we have a match for named routes
- $self->match(MojoX::Routes::Match->new($self)->root($self->app->routes))
+ $self->match(
+ Mojolicious::Routes::Match->new($self)->root($self->app->routes))
unless $self->match;
# Path
@@ -431,9 +771,6 @@ sub write {
$self->rendered;
}
-# This calls for a party, baby.
-# I'm ordering 100 kegs, 100 hookers and 100 Elvis impersonators that aren't
-# above a little hooking should the occasion arise.
sub write_chunk {
my ($self, $chunk, $cb) = @_;
@@ -480,14 +817,34 @@ C<controller_class> in your application.
=head1 ATTRIBUTES
-L<Mojolicious::Controller> inherits all attributes from
-L<MojoX::Dispatcher::Routes::Controller>.
+L<Mojolicious::Controller> inherits all attributes from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 C<app>
+
+ my $app = $c->app;
+ $c = $c->app(Mojolicious->new);
+
+A reference back to the application that dispatched to this controller.
+
+=head2 C<match>
+
+ my $m = $c->match;
+
+A L<Mojolicious::Routes::Match> object containing the routes results for the
+current request.
+
+=head2 C<tx>
+
+ my $tx = $c->tx;
+
+The transaction that is currently being processed, defaults to a
+L<Mojo::Transaction::HTTP> object.
=head1 METHODS
-L<Mojolicious::Controller> inherits all methods from
-L<MojoX::Dispatcher::Routes::Controller> and implements the following new
-ones.
+L<Mojolicious::Controller> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
=head2 C<client>
@@ -504,20 +861,41 @@ A L<Mojo::Client> prepared for the current environment.
$c->render_data($client->res->body);
})->start;
-For async processing you can use C<finish>.
+Some environments such as L<Mojo::Server::Daemon> even allow async requests.
$c->client->async->get('http://mojolicious.org' => sub {
my $client = shift;
$c->render_data($client->res->body);
- $c->finish;
})->start;
+=head2 C<cookie>
+
+ $c = $c->cookie(foo => 'bar');
+ $c = $c->cookie(foo => 'bar', {path => '/'});
+ my $value = $c->cookie('foo');
+ my @values = $c->cookie('foo');
+
+Access request cookie values and create new response cookies.
+
=head2 C<finish>
$c->finish;
Gracefully end WebSocket connection.
+=head2 C<flash>
+
+ my $flash = $c->flash;
+ my $foo = $c->flash('foo');
+ $c = $c->flash({foo => 'bar'});
+ $c = $c->flash(foo => 'bar');
+
+Data storage persistent for the next request, stored in the session.
+
+ $c->flash->{foo} = 'bar';
+ my $foo = $c->flash->{foo};
+ delete $c->flash->{foo};
+
=head2 C<on_finish>
$c->on_finish(sub {...});
@@ -539,6 +917,15 @@ connection in progress.
my ($self, $message) = @_;
});
+=head2 C<param>
+
+ my @names = $c->param;
+ my $foo = $c->param('foo');
+ my @foo = $c->param('foo');
+ $c = $c->param(foo => 'ba;r');
+
+Request parameters and routes captures.
+
=head2 C<redirect_to>
$c = $c->redirect_to('named');
@@ -561,7 +948,7 @@ Prepare a C<302> redirect response.
$c->render('foo/bar');
$c->render('foo/bar', format => 'html');
-This is a wrapper around L<MojoX::Renderer> exposing pretty much all
+This is a wrapper around L<Mojolicious::Renderer> exposing pretty much all
functionality provided by it.
It will set a default template to use based on the controller and action name
or fall back to the route name.
@@ -583,7 +970,7 @@ Render binary data, similar to C<render_text> but data will not be encoded.
Render the exception template C<exception.html.$handler>.
Will set the status code to C<500> meaning C<Internal Server Error>.
Takes a L<Mojo::Exception> object or error message and will fall back to
-rendering a static C<500> page using L<MojoX::Renderer::Static>.
+rendering a static C<500> page using L<Mojolicious::Static>.
=head2 C<render_inner>
@@ -609,7 +996,7 @@ Render a data structure as JSON.
Render the not found template C<not_found.html.$handler>.
Also sets the response status code to C<404>, will fall back to rendering a
-static C<404> page using L<MojoX::Renderer::Static>.
+static C<404> page using L<Mojolicious::Static>.
=head2 C<render_partial>
@@ -623,7 +1010,7 @@ Same as C<render> but returns the rendered result.
$c->render_static('images/logo.png');
$c->render_static('../lib/MyApp.pm');
-Render a static file using L<MojoX::Dispatcher::Static> relative to the
+Render a static file using L<Mojolicious::Static> relative to the
C<public> directory of your application.
=head2 C<render_text>
@@ -641,6 +1028,20 @@ See C<render_data> for an alternative without encoding.
Finalize response and run C<after_dispatch> plugin hook.
Note that this method is EXPERIMENTAL and might change without warning!
+=head2 C<req>
+
+ my $req = $c->req;
+
+Alias for C<$c->tx->req>.
+Usually refers to a L<Mojo::Message::Request> object.
+
+=head2 C<res>
+
+ my $res = $c->res;
+
+Alias for C<$c->tx->res>.
+Usually refers to a L<Mojo::Message::Response> object.
+
=head2 C<send_message>
$c = $c->send_message('Hi there!');
@@ -648,6 +1049,43 @@ Note that this method is EXPERIMENTAL and might change without warning!
Send a message via WebSocket, only works if there is currently a WebSocket
connection in progress.
+=head2 C<session>
+
+ my $session = $c->session;
+ my $foo = $c->session('foo');
+ $c = $c->session({foo => 'bar'});
+ $c = $c->session(foo => 'bar');
+
+Persistent data storage, by default stored in a signed cookie.
+Note that cookies are generally limited to 4096 bytes of data.
+
+ $c->session->{foo} = 'bar';
+ my $foo = $c->session->{foo};
+ delete $c->session->{foo};
+
+=head2 C<signed_cookie>
+
+ $c = $c->signed_cookie(foo => 'bar');
+ $c = $c->signed_cookie(foo => 'bar', {path => '/'});
+ my $value = $c->signed_cookie('foo');
+ my @values = $c->signed_cookie('foo');
+
+Access signed request cookie values and create new signed response cookies.
+Cookies failing signature verification will be automatically discarded.
+
+=head2 C<stash>
+
+ my $stash = $c->stash;
+ my $foo = $c->stash('foo');
+ $c = $c->stash({foo => 'bar'});
+ $c = $c->stash(foo => 'bar');
+
+Non persistent data storage and exchange.
+
+ $c->stash->{foo} = 'bar';
+ my $foo = $c->stash->{foo};
+ delete $c->stash->{foo};
+
=head2 C<url_for>
my $url = $c->url_for;
@@ -684,13 +1122,19 @@ Write dynamic content chunk wise with the C<chunked> C<Transfer-Encoding>
which doesn't require a C<Content-Length> header, the optional drain callback
will be invoked once all data has been written to the kernel send buffer or
equivalent.
-An empty chunk marks the end of the stream.
+Note that this method is EXPERIMENTAL and might change without warning!
$c->write_chunk('Hel');
$c->write_chunk('lo!');
$c->write_chunk('');
-Note that this method is EXPERIMENTAL and might change without warning!
+An empty chunk marks the end of the stream.
+
+ 3
+ Hel
+ 3
+ lo!
+ 0
=head1 SEE ALSO
@@ -167,13 +167,6 @@ C<DNS> server to use for non-blocking lookups.
MOJO_DNS_SERVER=8.8.8.8
-=head2 C<MOJO_EPOLL>
-
-Force epoll mainloop for IO operations.
-Note that L<IO::Epoll> must be installed for epoll support.
-
- MOJO_EPOLL=1
-
=head2 C<MOJO_HOME>
Home directory for the L<Mojolicious> application, should always contain a
@@ -181,13 +174,6 @@ path like C</home/sri/myapp>.
MOJO_HOME=/home/sri/myapp
-=head2 C<MOJO_KQUEUE>
-
-Force kqueue mainloop for IO operations.
-Note that L<IO::KQueue> must be installed for kqueue support.
-
- MOJO_KQUEUE=1
-
=head2 C<MOJO_LOG_LEVEL>
Log level for the L<Mojolicious> application, should contain a valid log
@@ -237,14 +223,6 @@ Note that L<Net::Rendezvous::Publish> must be installed for Bonjour support.
MOJO_NO_BONJOUR=1
-=head2 C<MOJO_NO_IPV6>
-
-Disable IPv6 support, this might result in slightly better performance and
-less memory use.
-Note that L<IO::Socket::IP> must be installed for IPv6 support.
-
- MOJO_NO_IPV6=1
-
=head2 C<MOJO_NO_TLS>
Disable TLS support, this might result in slightly better performance and
@@ -35,6 +35,63 @@ Another huge advantage is that it supports TLS and WebSockets out of the box.
A development certificate for testing purposes is built right in, so it just
works.
+=head2 Hypnotoad
+
+For bigger applications L<Mojolicious> contains the UNIX optimized preforking
+web server L<Mojo::Server::Hypnotoad> that will allow you to take advantage
+of multiple cpu cores and copy-on-write.
+
+ Mojo::Server::Hypnotoad
+ |- Mojo::Server::Daemon [1]
+ |- Mojo::Server::Daemon [2]
+ |- Mojo::Server::Daemon [3]
+ `- Mojo::Server::Daemon [4]
+
+It is based on the normal builtin web server but optimized specifically for
+production environments out of the box.
+
+ % hypnotoad script/myapp
+ Server available at http://*:8080.
+
+Config files are plain Perl scripts for maximal customizability.
+
+ # hypnotoad.conf
+ {listen => ['http://*:80'], workers => 10};
+
+But one of its biggest advantages is the support for effortless zero downtime
+software upgrades.
+That means you can upgrade L<Mojolicious>, Perl or even system libraries at
+runtime without ever stopping the server or losing a single incoming
+connection, just by sending it a C<USR2> signal.
+
+ % kill -s 'USR2' `cat hypnotoad.pid`
+
+=head2 Nginx
+
+One of the most popular setups these days is the builtin web server behind a
+Nginx reverse proxy.
+
+ upstream myapp {
+ server 127.0.0.1:8080;
+ }
+ server {
+ listen 80;
+ server_name localhost;
+ location / {
+ proxy_read_timeout 300;
+ proxy_pass http://myapp;
+ proxy_set_header Host $http_host;
+ proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;
+ }
+ }
+
+You might also want to enable reverse proxy support in C<hypnotoad> if your
+proxy is on a different physical machine than your application and can't be
+auto detected.
+
+ # hypnotoad.conf
+ {proxy => 1};
+
=head2 Apache/CGI
C<CGI> is supported out of the box and your L<Mojolicious> application will
@@ -41,7 +41,7 @@ More capable editors can handle this accordingly and force the change.
Quite possibly this oneliner.
- sudo -s 'curl -L cpanmin.us | perl - "Mojolicious"'
+ curl -L cpanmin.us | perl - http://latest.mojolicio.us
=head2 I think L<Mojolicious> is awesome, how can i support you guys?
@@ -49,9 +49,11 @@ Share your success story via blog or twitter, get more people hooked! :)
=head2 I think i have found a bug, what should i do now?
-Prepare a test case demonstrating the bug, you are not expected to fix it
-yourself, but you'll have to make sure the developers can replicate your
-problem.
+First make sure you are using the latest version of L<Mojolicious>, it is
+quite likely that the bug has already been fixed.
+If that doesn't help prepare a test case demonstrating the bug, you are not
+expected to fix it yourself, but you'll have to make sure the developers can
+replicate your problem.
Sending in your whole application generally does more harm than good, the
C<t> directory of this distribution has many good examples for how to do it
right.
@@ -59,7 +61,7 @@ Writing a test is usually the hardest part of fixing a bug, so the better
your test case the faster it can be fixed. ;)
Once thats done you can contact the developers via GitHub
-(http://github.com/kraih/mojo), mailing list
+(L<https://github.com/kraih/mojo/issues>), mailing list
(L<http://groups.google.com/group/mojolicious>) or IRC
(C<#mojo> on C<irc.perl.org>).
@@ -448,6 +448,41 @@ executed more than once.
Less commonly used and more powerful features.
+=head2 Chunked Transfer Encoding
+
+For very dynamic content you might not know the response C<Content-Length>
+in advance, thats where the C<chunked> C<Transfer-Encoding> comes in handy.
+A common use would be to send the C<head> section of an HTML document to the
+browser in advance and speed up preloading of referenced images and
+stylesheets.
+
+ $self->write_chunk('<html><head><title>Example</title>');
+ $self->write_chunk('<link href="example.css" rel="stylesheet"');
+ $self->write_chunk(' type="text/css" /></head>', sub {
+ my $self = shift;
+ $self->write_chunk('<body>Example</body></html>');
+ $self->write_chunk('');
+ });
+
+The optional drain callback ensures that all previous chunks have been
+written before processing continues.
+An empty chunk marks the end of the stream.
+
+ 22
+ <html><head><title>Example</title>
+ 29
+ <link href="example.css" rel="stylesheet"
+ 19
+ type="text/css" /></head>
+ 1C
+ <body>Example</body></html>
+ 0
+
+Especially in combination with long connection timeouts this can be very
+useful for Comet (C<long polling>).
+Due to limitations in some web servers this might not work perfectly in all
+deployment environments.
+
=head2 Encoding
Templates stored in files are expected to be C<UTF-8> by default, but that
@@ -408,6 +408,37 @@ ones.
$foo->route('/baz')->to(action => 'baz');
$foo->route('/cde');
+=head2 Mojolicious::Lite routes
+
+L<Mojolicious::Lite> routes are in fact just a small convenience layer around
+everything described above and also part of the normal router.
+
+ # GET /foo -> {controller => 'foo', action => 'abc'}
+ $r->get('/foo')->to(controller => 'foo', action => 'abc');
+
+This makes the process of growing your L<Mojolicious::Lite> prototypes into
+full L<Mojolicious> applications very straightforward.
+
+ # POST /bar
+ $r->post('/bar' => sub {
+ my $self = shift;
+ $self->render(text => 'Just like a Mojolicious::Lite action!');
+ });
+
+Even the more abstract concepts are available.
+
+ # GET /yada
+ # POST /yada
+ my $yada = $r->under('/yada');
+ $yada->get(sub {
+ my $self = shift;
+ $self->render(text => 'Hello!');
+ });
+ $yada->post(sub {
+ my $self = shift;
+ $self->render(text => 'Go away!');
+ });
+
=head1 ADVANCED
Less commonly used and more powerful features.
@@ -646,7 +677,7 @@ Now just load the plugin and you're done.
You can restrict access to WebSocket handshakes using the C<websocket> method.
# /ws (WebSocket handshake)
- $r->route('/echo')->websocket->to(controller => 'foo', action => 'echo');
+ $r->websocket('/echo')->to(controller => 'foo', action => 'echo');
# Controller
package MyApp::Foo;
@@ -10,9 +10,6 @@ use base 'Mojolicious';
use File::Spec;
use FindBin;
-# Make reloading work
-BEGIN { $INC{$0} = $0 }
-
# It's the future, my parents, my co-workers, my girlfriend,
# I'll never see any of them ever again... YAHOOO!
sub import {
@@ -32,68 +29,6 @@ sub import {
my $routes = $app->routes;
$routes->namespace('');
- # Route generator
- my $route = sub {
- my ($methods, @args) = @_;
-
- my ($cb, $constraints, $defaults, $name, $pattern);
- my $conditions = [];
-
- # Route information
- while (defined(my $arg = shift @args)) {
-
- # First scalar is the pattern
- if (!ref $arg && !$pattern) { $pattern = $arg }
-
- # Scalar
- elsif (!ref $arg && @args) {
- push @$conditions, $arg, shift @args;
- }
-
- # Last scalar is the route name
- elsif (!ref $arg) { $name = $arg }
-
- # Callback
- elsif (ref $arg eq 'CODE') { $cb = $arg }
-
- # Constraints
- elsif (ref $arg eq 'ARRAY') { $constraints = $arg }
-
- # Defaults
- elsif (ref $arg eq 'HASH') { $defaults = $arg }
- }
-
- # Defaults
- $constraints ||= [];
-
- # Defaults
- $defaults ||= {};
- $defaults->{cb} = $cb if $cb;
-
- # Name
- $name ||= '';
-
- # Create bridge
- return $routes =
- $app->routes->bridge($pattern, {@$constraints})->over($conditions)
- ->to($defaults)->name($name)
- if !ref $methods && $methods eq 'under';
-
- # WebSocket
- my $websocket = 1 if !ref $methods && $methods eq 'websocket';
- $methods = [] if $websocket;
-
- # Create route
- my $route =
- $routes->route($pattern, {@$constraints})->over($conditions)
- ->via($methods)->to($defaults)->name($name);
-
- # WebSocket
- $route->websocket if $websocket;
-
- return $route;
- };
-
# Prepare exports
my $caller = caller;
no strict 'refs';
@@ -103,15 +38,20 @@ sub import {
$app->static->default_static_class($caller);
$app->renderer->default_template_class($caller);
+ # Root
+ my $root = $routes;
+
# Export
*{"${caller}::new"} = *{"${caller}::app"} = sub {$app};
- *{"${caller}::any"} = sub { $route->(ref $_[0] ? shift : [], @_) };
- *{"${caller}::get"} = sub { $route->('get', @_) };
+ *{"${caller}::any"} = sub { $routes->any(@_) };
+ *{"${caller}::del"} = sub { $routes->del(@_) };
+ *{"${caller}::get"} = sub { $routes->get(@_) };
*{"${caller}::under"} = *{"${caller}::ladder"} =
- sub { $route->('under', @_) };
+ sub { $routes = $root->under(@_) };
*{"${caller}::plugin"} = sub { $app->plugin(@_) };
- *{"${caller}::post"} = sub { $route->('post', @_) };
- *{"${caller}::websocket"} = sub { $route->('websocket', @_) };
+ *{"${caller}::post"} = sub { $routes->post(@_) };
+ *{"${caller}::put"} = sub { $routes->put(@_) };
+ *{"${caller}::websocket"} = sub { $routes->websocket(@_) };
# We are most likely the app in a lite environment
$ENV{MOJO_APP} = $app;
@@ -196,6 +136,8 @@ option, so you don't have to restart the server after every change.
Routes are basically just fancy paths that can contain different kinds of
placeholders.
+C<$self> is an instance of L<Mojolicious::Controller> containing both the
+HTTP request and response.
# /foo
get '/foo' => sub {
@@ -379,8 +321,15 @@ Routes can be restricted to specific request methods.
All placeholders get compiled to a regex internally, with regex constraints
this process can be easily customized.
- # /*
- any '/:bar' => [bar => qr/\d+/] => sub {
+ # /* (digits)
+ any '/:foo' => [foo => qr/\d+/] => sub {
+ my $self = shift;
+ my $foo = $self->param('foo');
+ $self->render(text => "Our :foo placeholder matched $foo");
+ };
+
+ # /* (everything else)
+ any '/:bar' => [bar => qr/.*/] => sub {
my $self = shift;
my $bar = $self->param('bar');
$self->render(text => "Our :bar placeholder matched $bar");
@@ -739,6 +688,13 @@ See also the tutorial above for more argument variations.
The L<Mojolicious::Lite> application.
+=head2 C<del>
+
+ my $route = del '/:foo' => sub {...};
+
+Generate route matching only C<DELETE> requests.
+See also the tutorial above for more argument variations.
+
=head2 C<get>
my $route = get '/:foo' => sub {...};
@@ -764,6 +720,13 @@ Load a plugin.
Generate route matching only C<POST> requests.
See also the tutorial above for more argument variations.
+=head2 C<put>
+
+ my $route = put '/:foo' => sub {...};
+
+Generate route matching only C<PUT> requests.
+See also the tutorial above for more argument variations.
+
=head2 C<under>
my $route = under sub {...};
@@ -49,6 +49,8 @@ Mojolicious::Plugin::AgentCondition - Agent Condition Plugin
L<Mojolicous::Plugin::AgentCondition> is a routes condition for user agent
based routes.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
=head1 METHODS
@@ -127,6 +127,8 @@ Mojolicious::Plugin::DefaultHelpers - Default Helpers Plugin
L<Mojolicous::Plugin::DefaultHelpers> is a collection of renderer helpers for
L<Mojolicious>.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
=head2 Helpers
@@ -36,10 +36,6 @@ sub register {
# Stash defaults
$c->stash->{layout} ||= undef;
- # Reload
- delete $r->{_epl_cache} if $ENV{MOJO_RELOAD};
- local $ENV{MOJO_RELOAD} = 0 if $ENV{MOJO_RELOAD};
-
# Cache
my $ec = $r->{_epl_cache} ||= {};
unless ($ec->{$cache}) {
@@ -118,6 +114,8 @@ It is based on L<Mojo::Template>, but extends it with some convenient syntax
sugar designed specifically for L<Mojolicious>.
It supports L<Mojolicious> template helpers and exposes the stash directly as
perl variables.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
=head2 Options
@@ -27,9 +27,6 @@ sub register {
return unless defined $path;
my $cache = delete $options->{cache} || $path;
- # Reload
- delete $r->{_epl_cache} if $ENV{MOJO_RELOAD};
-
# Check cache
my $ec = $r->{_epl_cache} ||= {};
my $stack = $r->{_epl_stack} ||= [];
@@ -81,7 +78,7 @@ sub register {
# Exception
if (ref $$output) {
my $e = $$output;
- $$output = '';
+ $$output = undef;
$c->render_exception($e);
}
@@ -110,6 +107,8 @@ Mojolicious::Plugin::EplRenderer - EPL Renderer Plugin
L<Mojolicous::Plugin::EplRenderer> is a renderer for C<epl> templates.
C<epl> templates are pretty much just raw L<Mojo::Template>.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
=head1 METHODS
@@ -46,6 +46,8 @@ Mojolicious::Plugin::PoweredBy - Powered By Plugin
L<Mojolicous::Plugin::PoweredBy> is a plugin that adds an C<X-Powered-By>
header which defaults to C<Mojolicious (Perl)>.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
=head2 Options
@@ -55,6 +55,8 @@ Mojolicious::Plugin::RequestTimer - Request Timer Plugin
L<Mojolicous::Plugin::RequestTimer> is a plugin to gather and log request
timing information.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
=head1 METHODS
@@ -13,6 +13,10 @@ use Mojo::Util 'xml_escape';
sub register {
my ($self, $app) = @_;
+ # Add "base_tag" helper
+ $app->helper(base_tag =>
+ sub { $self->_tag('base', href => shift->url_for->base, @_) });
+
# Add "checkbox" helper
$app->helper(
check_box => sub {
@@ -69,23 +73,21 @@ sub register {
my $c = shift;
# CDATA
- my $cb;
- my $old = $cb = pop if ref $_[-1] && ref $_[-1] eq 'CODE';
- $cb = sub { '<![CDATA[' . $old->() . ']]>' }
- if $cb;
+ my $cb = sub {''};
+ if (ref $_[-1] && ref $_[-1] eq 'CODE') {
+ my $old = pop;
+ $cb = sub { "//<![CDATA[\n" . $old->() . "\n//]]>" }
+ }
# Path
- if (@_ % 2 ? ref $_[-1] ne 'CODE' : ref $_[-1] eq 'CODE') {
- return $self->_tag(
- 'script',
- src => shift,
- type => 'text/javascript',
- @_
- );
- }
+ my $src;
+ $src = shift if @_ % 2;
- # Block
- $self->_tag('script', type => 'text/javascript', @_, $cb);
+ # Attributes
+ my %attrs = @_;
+ $attrs{src} = $src if $src;
+
+ $self->_tag('script', type => 'text/javascript', %attrs, $cb);
}
);
@@ -189,24 +191,30 @@ sub register {
# CDATA
my $cb;
- my $old = $cb = pop if ref $_[-1] && ref $_[-1] eq 'CODE';
- $cb = sub { '<![CDATA[' . $old->() . ']]>' }
- if $cb;
+ if (ref $_[-1] && ref $_[-1] eq 'CODE') {
+ my $old = pop;
+ $cb = sub { "/*<![CDATA[*/\n" . $old->() . "\n/*]]>*/" }
+ }
# Path
- if (@_ % 2 ? ref $_[-1] ne 'CODE' : ref $_[-1] eq 'CODE') {
- return $self->_tag(
- 'link',
- href => shift,
- media => 'screen',
- rel => 'stylesheet',
- type => 'text/css',
- @_
- );
- }
+ my $href;
+ $href = shift if @_ % 2;
- # Block
- $self->_tag('style', type => 'text/css', @_, $cb);
+ # Attributes
+ my %attrs = @_;
+
+ # Link
+ return $self->_tag(
+ 'link',
+ href => $href,
+ media => 'screen',
+ rel => 'stylesheet',
+ type => 'text/css',
+ %attrs
+ ) if $href;
+
+ # Style
+ $self->_tag('style', type => 'text/css', %attrs, $cb);
}
);
@@ -330,12 +338,22 @@ Mojolicious::Plugin::TagHelpers - Tag Helpers Plugin
L<Mojolicous::Plugin::TagHelpers> is a collection of HTML5 tag helpers for
L<Mojolicious>.
+This is a core plugin, that means it is always enabled and its code a good
+example for learning to build new plugins.
Note that this module is EXPERIMENTAL and might change without warning!
=head2 Helpers
=over 4
+=item base_tag
+
+ <%= base_tag %>
+
+Generate C<base> tag refering to the current base URL.
+
+ <base href="http://localhost/cgi-bin/myapp.pl" />
+
=item check_box
<%= check_box employed => 1 %>
@@ -0,0 +1,506 @@
+package Mojolicious::Renderer;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use File::Spec;
+use Mojo::ByteStream 'b';
+use Mojo::Command;
+use Mojo::Home;
+use Mojo::JSON;
+use Mojo::Util 'encode';
+
+__PACKAGE__->attr(default_format => 'html');
+__PACKAGE__->attr([qw/default_handler default_template_class/]);
+__PACKAGE__->attr(detect_templates => 1);
+__PACKAGE__->attr(encoding => 'UTF-8');
+__PACKAGE__->attr(handler => sub { {} });
+__PACKAGE__->attr(helper => sub { {} });
+__PACKAGE__->attr(layout_prefix => 'layouts');
+__PACKAGE__->attr(root => '/');
+
+# This is not how Xmas is supposed to be.
+# In my day Xmas was about bringing people together, not blowing them apart.
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # Data
+ $self->add_handler(
+ data => sub {
+ my ($r, $c, $output, $options) = @_;
+ $$output = $options->{data};
+ }
+ );
+
+ # JSON
+ $self->add_handler(
+ json => sub {
+ my ($r, $c, $output, $options) = @_;
+ $$output = Mojo::JSON->new->encode($options->{json});
+ }
+ );
+
+ # Text
+ $self->add_handler(
+ text => sub {
+ my ($r, $c, $output, $options) = @_;
+ $$output = $options->{text};
+ }
+ );
+
+ return $self;
+}
+
+sub add_handler {
+ my ($self, $name, $cb) = @_;
+ $self->handler->{$name} = $cb;
+ return $self;
+}
+
+sub add_helper {
+ my ($self, $name, $cb) = @_;
+ $self->helper->{$name} = $cb;
+ return $self;
+}
+
+sub get_inline_template {
+ my ($self, $options, $template) = @_;
+ return Mojo::Command->new->get_data($template,
+ $self->_detect_template_class($options));
+}
+
+# Bodies are for hookers and fat people.
+sub render {
+ my ($self, $c, $args) = @_;
+
+ # Stash
+ my $stash = $c->stash;
+
+ # Arguments
+ $args ||= {};
+
+ # Content
+ my $content = $stash->{'mojo.content'} ||= {};
+
+ # Partial
+ my $partial = $args->{partial};
+
+ # Localize extends and layout
+ local $stash->{layout} = $partial ? undef : $stash->{layout};
+ local $stash->{extends} = $partial ? undef : $stash->{extends};
+
+ # Merge stash and arguments
+ while (my ($key, $value) = each %$args) {
+ $stash->{$key} = $value;
+ }
+
+ # Template
+ my $template = delete $stash->{template};
+
+ # Template class
+ my $class = $stash->{template_class};
+
+ # Format
+ my $format = $stash->{format} || $self->default_format;
+
+ # Handler
+ my $handler = $stash->{handler};
+
+ # Data
+ my $data = delete $stash->{data};
+
+ # JSON
+ my $json = delete $stash->{json};
+
+ # Text
+ my $text = delete $stash->{text};
+
+ # Inline
+ my $inline = delete $stash->{inline};
+ $handler = $self->default_handler if defined $inline && !defined $handler;
+
+ my $options = {
+ template => $template,
+ format => $format,
+ handler => $handler,
+ encoding => $self->encoding,
+ inline => $inline,
+ template_class => $class
+ };
+ my $output;
+
+ # Text
+ if (defined $text) {
+
+ # Render
+ $self->handler->{text}->($self, $c, \$output, {text => $text});
+
+ # Extends
+ $content->{content} = b("$output")
+ if ($c->stash->{extends} || $c->stash->{layout});
+ }
+
+ # Data
+ elsif (defined $data) {
+
+ # Render
+ $self->handler->{data}->($self, $c, \$output, {data => $data});
+
+ # Extends
+ $content->{content} = b("$output")
+ if ($c->stash->{extends} || $c->stash->{layout});
+ }
+
+ # JSON
+ elsif (defined $json) {
+
+ # Render
+ $self->handler->{json}->($self, $c, \$output, {json => $json});
+ $format = 'json';
+
+ # Extends
+ $content->{content} = b("$output")
+ if ($c->stash->{extends} || $c->stash->{layout});
+ }
+
+ # Template or templateless handler
+ else {
+
+ # Render
+ return unless $self->_render_template($c, \$output, $options);
+
+ # Extends
+ $content->{content} = b("$output")
+ if ($c->stash->{extends} || $c->stash->{layout});
+ }
+
+ # Extends
+ while ((my $extends = $self->_extends($c)) && !$json && !$data) {
+
+ # Stash
+ my $stash = $c->stash;
+
+ # Template class
+ $class = $stash->{template_class};
+ $options->{template_class} = $class;
+
+ # Handler
+ $handler = $stash->{handler};
+ $options->{handler} = $handler;
+
+ # Format
+ $format = $stash->{format} || $self->default_format;
+ $options->{format} = $format;
+
+ # Template
+ $options->{template} = $extends;
+
+ # Render
+ $self->_render_template($c, \$output, $options);
+ }
+
+ # Encoding (JSON is already encoded)
+ unless ($partial) {
+ my $encoding = $options->{encoding};
+ encode $encoding, $output if $encoding && $output && !$json && !$data;
+ }
+
+ # Type
+ my $type = $c->app->types->type($format) || 'text/plain';
+
+ return ($output, $type);
+}
+
+sub template_name {
+ my ($self, $options) = @_;
+
+ # Template
+ return unless my $template = $options->{template} || '';
+
+ # Format
+ return unless my $format = $options->{format};
+
+ # Handler
+ my $handler = $options->{handler};
+
+ # File
+ my $file = "$template.$format";
+ $file = "$file.$handler" if $handler;
+
+ return $file;
+}
+
+sub template_path {
+ my $self = shift;
+ return unless my $name = $self->template_name(shift);
+ return File::Spec->catfile($self->root, split '/', $name);
+}
+
+sub _detect_handler {
+ my ($self, $options) = @_;
+
+ # Disabled
+ return unless $self->detect_templates;
+
+ # Template class
+ my $class = $self->_detect_template_class($options);
+
+ # Templates
+ my $templates = $self->{_templates};
+ unless ($templates) {
+ $templates = $self->{_templates} =
+ Mojo::Home->new->parse($self->root)->list_files;
+ }
+
+ # Inline templates
+ my $inline = $self->{_inline_templates}->{$class}
+ ||= $self->_list_inline_templates($class);
+
+ # Detect
+ return unless my $file = $self->template_name($options);
+ $file = quotemeta $file;
+ for my $template (@$templates, @$inline) {
+ if ($template =~ /^$file\.(\w+)$/) { return $1 }
+ }
+
+ return;
+}
+
+# You are hereby conquered.
+# Please line up in order of how much beryllium it takes to kill you.
+sub _detect_template_class {
+ my ($self, $options) = @_;
+ return
+ $options->{template_class}
+ || $ENV{MOJO_TEMPLATE_CLASS}
+ || $self->default_template_class
+ || 'main';
+}
+
+sub _extends {
+ my ($self, $c) = @_;
+
+ # Layout
+ my $stash = $c->stash;
+ if (my $layout = delete $stash->{layout}) {
+ $stash->{extends} ||= $self->layout_prefix . '/' . $layout;
+ }
+
+ # Extends
+ return delete $stash->{extends};
+}
+
+sub _list_inline_templates {
+ my ($self, $class) = @_;
+
+ # Get all
+ my $all = Mojo::Command->new->get_all_data($class);
+
+ # List
+ return [keys %$all];
+}
+
+# Well, at least here you'll be treated with dignity.
+# Now strip naked and get on the probulator.
+sub _render_template {
+ my ($self, $c, $output, $options) = @_;
+
+ # Renderer
+ my $handler =
+ $options->{handler}
+ || $self->_detect_handler($options)
+ || $self->default_handler;
+ $options->{handler} = $handler;
+ my $renderer = $self->handler->{$handler};
+
+ # No handler
+ unless ($renderer) {
+ $c->app->log->error(qq/No handler for "$handler" available./);
+ return;
+ }
+
+ # Render
+ return unless $renderer->($self, $c, $output, $options);
+
+ # Success!
+ return 1;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Renderer - MIME Type Based Renderer
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Renderer;
+
+ my $renderer = Mojolicious::Renderer->new;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Renderer> is the standard L<Mojolicious> renderer.
+It turns your stashed data structures into content.
+See L<Mojolicious::Guide::Rendering> for more.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Renderer> implements the following attributes.
+
+=head2 C<default_format>
+
+ my $default = $renderer->default_format;
+ $renderer = $renderer->default_format('html');
+
+The default format to render if C<format> is not set in the stash.
+The renderer will use L<Mojolicious::Types> to look up the content MIME type.
+
+=head2 C<default_handler>
+
+ my $default = $renderer->default_handler;
+ $renderer = $renderer->default_handler('epl');
+
+The default template handler to use for rendering in cases where auto
+detection doesn't work, like for C<inline> templates.
+
+=over 4
+
+=item epl
+
+C<Embedded Perl Lite> handled by L<Mojolicious::Plugin::EplRenderer>.
+
+=item ep
+
+C<Embedded Perl> handled by L<Mojolicious::Plugin::EpRenderer>.
+
+=back
+
+=head2 C<default_template_class>
+
+ my $default = $renderer->default_template_class;
+ $renderer = $renderer->default_template_class('main');
+
+The renderer will use this class to look for templates in the C<DATA>
+section.
+
+=head2 C<detect_templates>
+
+ my $detect = $renderer->detect_templates;
+ $renderer = $renderer->detect_templates(1);
+
+Template auto detection, the renderer will try to select the right template
+and renderer automatically.
+
+=head2 C<encoding>
+
+ my $encoding = $renderer->encoding;
+ $renderer = $renderer->encoding('koi8-r');
+
+Will encode the content if set, defaults to C<UTF-8>.
+
+=head2 C<handler>
+
+ my $handler = $renderer->handler;
+ $renderer = $renderer->handler({epl => sub { ... }});
+
+Registered handlers.
+
+=head2 C<helper>
+
+ my $helper = $renderer->helper;
+ $renderer = $renderer->helper({url_for => sub { ... }});
+
+Registered helpers.
+
+=head2 C<layout_prefix>
+
+ my $prefix = $renderer->layout_prefix;
+ $renderer = $renderer->layout_prefix('layouts');
+
+Directory to look for layouts in, defaults to C<layouts>.
+
+=head2 C<root>
+
+ my $root = $renderer->root;
+ $renderer = $renderer->root('/foo/bar/templates');
+
+Directory to look for templates in.
+
+=head1 METHODS
+
+L<Mojolicious::Renderer> inherits all methods from L<Mojo::Base> and implements the
+following ones.
+
+=head2 C<new>
+
+ my $renderer = Mojolicious::Renderer->new;
+
+Construct a new renderer.
+
+=head2 C<add_handler>
+
+ $renderer = $renderer->add_handler(epl => sub { ... });
+
+Add a new handler to the renderer.
+See L<Mojolicious::Plugin::EpRenderer> for a sample renderer.
+
+=head2 C<add_helper>
+
+ $renderer = $renderer->add_helper(url_for => sub { ... });
+
+Add a new helper to the renderer.
+See L<Mojolicious::Plugin::EpRenderer> for sample helpers.
+
+=head2 C<get_inline_template>
+
+ my $template = $renderer->get_inline_template({
+ template => 'foo/bar',
+ format => 'html',
+ handler => 'epl'
+ template_class => 'main'
+ }, 'foo.html.ep');
+
+Get an inline template by name, usually used by handlers.
+
+=head2 C<render>
+
+ my ($output, $type) = $renderer->render($c);
+ my ($output, $type) = $renderer->render($c, $args);
+
+Render output through one of the Mojo renderers.
+This renderer requires some configuration, at the very least you will need to
+have a default C<format> and a default C<handler> as well as a C<template> or
+C<text>/C<json>.
+See L<Mojolicious::Controller> for a more user friendly interface.
+
+=head2 C<template_name>
+
+ my $template = $renderer->template_name({
+ template => 'foo/bar',
+ format => 'html',
+ handler => 'epl'
+ });
+
+Builds a template name based on an options hash with C<template>, C<format>
+and C<handler>.
+
+=head2 C<template_path>
+
+ my $path = $renderer->template_path({
+ template => 'foo/bar',
+ format => 'html',
+ handler => 'epl'
+ });
+
+Builds a full template path based on an options hash with C<template>,
+C<format> and C<handler>.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,326 @@
+package Mojolicious::Routes::Match;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use Carp 'croak';
+use Mojo::Util qw/decode url_unescape/;
+use Mojo::URL;
+use Scalar::Util 'weaken';
+
+__PACKAGE__->attr(captures => sub { {} });
+__PACKAGE__->attr([qw/endpoint root/]);
+__PACKAGE__->attr(stack => sub { [] });
+
+# I'm Bender, baby, please insert liquor!
+sub new {
+ my $self = shift->SUPER::new();
+ my $c = shift;
+
+ # Controller
+ $self->{_controller} = $c;
+ weaken $self->{_controller};
+
+ # Path
+ unless ($self->{_path} = shift) {
+ $self->{_path} = $c->req->url->path->to_string;
+ url_unescape $self->{_path};
+ decode 'UTF8', $self->{_path};
+ }
+
+ return $self;
+}
+
+# Life can be hilariously cruel.
+sub match {
+ my ($self, $r) = @_;
+
+ # Shortcut
+ return unless $r;
+
+ # Dictionary
+ my $dictionary = $self->{_dictionary} ||= $r->dictionary;
+
+ # Root
+ $self->root($r) unless $self->root;
+
+ # Path
+ my $path = $self->{_path};
+
+ # Pattern
+ my $pattern = $r->pattern;
+
+ # Match
+ my $captures = $pattern->shape_match(\$path);
+
+ # No match
+ return unless $captures;
+
+ # Merge captures
+ $captures = {%{$self->captures}, %$captures};
+ $self->captures($captures);
+
+ # Conditions
+ my $conditions = $r->conditions;
+ for (my $i = 0; $i < @$conditions; $i += 2) {
+ my $name = $conditions->[$i];
+ my $value = $conditions->[$i + 1];
+ my $condition = $dictionary->{$name};
+
+ # No condition
+ return unless $condition;
+
+ # Match
+ return
+ if !$condition->($r, $self->{_controller}, $captures, $value);
+ }
+
+ # Partial
+ if (my $partial = $r->partial) {
+ $captures->{$partial} = $path;
+ $path = '';
+ }
+ $self->{_path} = $path;
+
+ # Format
+ if ($r->is_endpoint && !$pattern->format) {
+ if ($path =~ /^\.([^\/]+)$/) {
+ $captures->{format} = $1;
+ $self->{_path} = '';
+ }
+ }
+ $captures->{format} ||= $pattern->format if $pattern->format;
+
+ # Update stack
+ if ($r->inline || ($r->is_endpoint && $self->_is_path_empty)) {
+ push @{$self->stack}, {%$captures};
+ delete $captures->{cb};
+ delete $captures->{app};
+ }
+
+ # Waypoint match
+ if ($r->block && $self->_is_path_empty) {
+ $self->endpoint($r);
+ return $self;
+ }
+
+ # Match children
+ my $snapshot = [@{$self->stack}];
+ for my $child (@{$r->children}) {
+
+ # Match
+ $self->match($child);
+
+ # Endpoint found
+ return $self if $self->endpoint;
+
+ # Reset path
+ $self->{_path} = $path;
+
+ # Reset stack
+ if ($r->parent) { $self->stack([@$snapshot]) }
+ else {
+ $self->captures({});
+ $self->stack([]);
+ }
+ }
+
+ $self->endpoint($r) if $r->is_endpoint && $self->_is_path_empty;
+
+ return $self;
+}
+
+sub url_for {
+ my $self = shift;
+ my $endpoint = $self->endpoint;
+ my $values = {};
+ my $name = undef;
+
+ # Single argument
+ if (@_ == 1) {
+
+ # Hash
+ $values = shift if ref $_[0] eq 'HASH';
+
+ # Name
+ $name = $_[0] if $_[0];
+ }
+
+ # Multiple arguments
+ elsif (@_ > 1) {
+
+ # Odd
+ if (@_ % 2) {
+ $name = shift;
+ $values = {@_};
+ }
+
+ # Even
+ else {
+
+ # Name and hashref
+ if (ref $_[1] eq 'HASH') {
+ $name = shift;
+ $values = shift;
+ }
+
+ # Just values
+ else { $values = {@_} }
+
+ }
+ }
+
+ # Captures
+ my $captures = $self->captures;
+
+ # Named
+ if ($name) {
+
+ # Current route
+ if ($name eq 'current') { $name = undef }
+
+ # Find
+ else {
+ $captures = {};
+ croak qq/Route "$name" used in url_for does not exist/
+ unless $endpoint = $self->_find_route($name);
+ }
+ }
+
+ # Merge values
+ $values = {%$captures, format => undef, %$values};
+
+ # URL
+ my $url = Mojo::URL->new;
+
+ # No endpoint
+ return $url unless $endpoint;
+
+ # Base
+ $url->base($self->{_controller}->req->url->base->clone);
+ my $base = $url->base;
+ $url->base->userinfo(undef);
+
+ # Render
+ my $path = $endpoint->render($url->path->to_string, $values);
+ $url->path->parse($path);
+
+ # Fix scheme
+ if ($endpoint->is_websocket) {
+ $base->scheme(($base->scheme || '') eq 'https' ? 'wss' : 'ws');
+ }
+
+ # Fix paths
+ unshift @{$url->path->parts}, @{$base->path->parts};
+ $base->path->parts([]);
+
+ return $url;
+}
+
+sub _find_route {
+ my ($self, $name) = @_;
+
+ # Find endpoint
+ my @children = ($self->root);
+ while (my $child = shift @children) {
+
+ # Match
+ return $child if ($child->name || '') eq $name;
+
+ # Append
+ push @children, @{$child->children};
+ }
+
+ # Not found
+ return;
+}
+
+sub _is_path_empty {
+ my $self = shift;
+ return 1 if !length $self->{_path} || $self->{_path} eq '/';
+ return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Routes::Match - Routes Visitor
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Routes::Match;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Routes::Match> is a visitor for L<Mojolicious::Routes>
+structures.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Routes::Match> implements the following attributes.
+
+=head2 C<captures>
+
+ my $captures = $m->captures;
+ $m = $m->captures({foo => 'bar'});
+
+Captured parameters.
+
+=head2 C<endpoint>
+
+ my $endpoint = $m->endpoint;
+ $m = $m->endpoint(Mojolicious::Routes->new);
+
+The routes endpoint that actually matched.
+
+=head2 C<root>
+
+ my $root = $m->root;
+ $m = $m->root($routes);
+
+The root of the routes tree.
+
+=head2 C<stack>
+
+ my $stack = $m->stack;
+ $m = $m->stack([{foo => 'bar'}]);
+
+Captured parameters with nesting history.
+
+=head1 METHODS
+
+L<Mojolicious::Routes::Match> inherits all methods from L<Mojo::Base> and
+implements the following ones.
+
+=head2 C<new>
+
+ my $m = Mojolicious::Routes::Match->new(Mojolicious:Controller->new);
+
+Construct a new match object.
+
+=head2 C<match>
+
+ $m->match(Mojolicious::Routes->new);
+
+Match against a routes tree.
+
+=head2 C<url_for>
+
+ my $url = $m->url_for;
+ my $url = $m->url_for(foo => 'bar');
+ my $url = $m->url_for({foo => 'bar'});
+ my $url = $m->url_for('named');
+ my $url = $m->url_for('named', foo => 'bar');
+ my $url = $m->url_for('named', {foo => 'bar'});
+
+Render matching route with parameters into a L<Mojo::URL> object.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,453 @@
+package Mojolicious::Routes::Pattern;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use constant DEBUG => $ENV{MOJO_ROUTES_DEBUG} || 0;
+
+__PACKAGE__->attr(defaults => sub { {} });
+__PACKAGE__->attr([qw/format pattern regex/]);
+__PACKAGE__->attr(quote_end => ')');
+__PACKAGE__->attr(quote_start => '(');
+__PACKAGE__->attr(relaxed_start => '.');
+__PACKAGE__->attr(reqs => sub { {} });
+__PACKAGE__->attr(symbol_start => ':');
+__PACKAGE__->attr(symbols => sub { [] });
+__PACKAGE__->attr(tree => sub { [] });
+__PACKAGE__->attr(wildcard_start => '*');
+
+# This is the worst kind of discrimination. The kind against me!
+sub new {
+ my $self = shift->SUPER::new();
+ $self->parse(@_);
+ return $self;
+}
+
+sub match {
+ my ($self, $path) = @_;
+
+ # Match
+ my $result = $self->shape_match(\$path);
+
+ # Endpoint
+ return $result if !$path || $path eq '/';
+
+ # Partial or no match
+ return;
+}
+
+sub parse {
+ my $self = shift;
+ my $pattern = shift;
+
+ # Shortcut
+ return $self unless defined $pattern;
+
+ # Make sure pattern starts with a slash
+ $pattern = "/$pattern" unless $pattern =~ /^\//;
+
+ # Format
+ if ($pattern =~ /\.([^\/\)]+)$/) { $self->format($1) }
+
+ # Requirements
+ my $reqs = ref $_[0] eq 'HASH' ? $_[0] : {@_};
+ $self->reqs($reqs);
+
+ # Tokenize
+ $self->pattern($pattern);
+ $self->_tokenize;
+
+ return $self;
+}
+
+sub render {
+ my ($self, $values) = @_;
+
+ # Merge values with defaults
+ $values ||= {};
+ $values = {%{$self->defaults}, %$values};
+
+ my $string = '';
+ my $optional = 1;
+ for my $token (reverse @{$self->tree}) {
+ my $op = $token->[0];
+ my $rendered = '';
+
+ # Slash
+ if ($op eq 'slash') {
+ $rendered = '/' unless $optional;
+ }
+
+ # Text
+ elsif ($op eq 'text') {
+ $rendered = $token->[1];
+ $optional = 0;
+ }
+
+ # Relaxed, symbol or wildcard
+ elsif ($op eq 'relaxed' || $op eq 'symbol' || $op eq 'wildcard') {
+ my $name = $token->[1];
+ $rendered = $values->{$name};
+ $rendered = '' unless defined $rendered;
+
+ my $default = $self->defaults->{$name};
+ $default = '' unless defined $default;
+
+ $optional = 0 unless $default eq $rendered;
+ $rendered = '' if $optional && $default eq $rendered;
+ }
+
+ $string = "$rendered$string";
+ }
+
+ return $string || '/';
+}
+
+sub shape_match {
+ my ($self, $pathref) = @_;
+
+ # Debug
+ if (DEBUG) {
+ my $pattern = $self->pattern || '';
+ warn " [$$pathref] -> [$pattern]\n";
+ }
+
+ # Compile on demand
+ $self->_compile unless $self->regex;
+
+ my $regex = $self->regex;
+
+ # Debug
+ warn " $regex\n" if DEBUG;
+
+ # Match
+ if (my @captures = $$pathref =~ /$regex/) {
+
+ # Substitute
+ $$pathref =~ s/$regex//;
+
+ # Merge captures
+ my $result = {%{$self->defaults}};
+ for my $symbol (@{$self->symbols}) {
+
+ # No captures
+ last unless @captures;
+
+ # Merge
+ my $capture = shift @captures;
+ $result->{$symbol} = $capture if defined $capture;
+ }
+ return $result;
+ }
+
+ return;
+}
+
+sub _compile {
+ my $self = shift;
+
+ my $block = '';
+ my $regex = '';
+ my $optional = 1;
+ for my $token (reverse @{$self->tree}) {
+ my $op = $token->[0];
+ my $compiled = '';
+
+ # Slash
+ if ($op eq 'slash') {
+
+ # Full block
+ $block = $optional ? "(?:/$block)?" : "/$block";
+
+ $regex = "$block$regex";
+ $block = '';
+
+ next;
+ }
+
+ # Text
+ elsif ($op eq 'text') {
+ $compiled = $token->[1];
+ $optional = 0;
+ }
+
+ # Symbol
+ elsif ($op eq 'relaxed' || $op eq 'symbol' || $op eq 'wildcard') {
+ my $name = $token->[1];
+
+ unshift @{$self->symbols}, $name;
+
+ # Relaxed
+ if ($op eq 'relaxed') { $compiled = '([^\/]+)' }
+
+ # Symbol
+ elsif ($op eq 'symbol') { $compiled = '([^\/\.]+)' }
+
+ # Wildcard
+ elsif ($op eq 'wildcard') { $compiled = '(.+)' }
+
+ my $req = $self->reqs->{$name};
+ $compiled = "($req)" if $req;
+
+ $optional = 0 unless exists $self->defaults->{$name};
+
+ $compiled .= '?' if $optional;
+ }
+
+ # Add to block
+ $block = "$compiled$block";
+ }
+
+ # Not rooted with a slash
+ $regex = "$block$regex" if $block;
+
+ $regex = qr/^$regex/;
+ $self->regex($regex);
+
+ return $self;
+}
+
+sub _tokenize {
+ my $self = shift;
+
+ my $pattern = $self->pattern;
+ my $quote_end = $self->quote_end;
+ my $quote_start = $self->quote_start;
+ my $relaxed_start = $self->relaxed_start;
+ my $symbol_start = $self->symbol_start;
+ my $wildcard_start = $self->wildcard_start;
+
+ my $tree = [];
+ my $state = 'text';
+
+ my $quoted = 0;
+ while (length(my $char = substr $pattern, 0, 1, '')) {
+
+ # Inside a symbol
+ my $symbol = 0;
+ $symbol = 1
+ if $state eq 'relaxed'
+ || $state eq 'symbol'
+ || $state eq 'wildcard';
+
+ # Quote start
+ if ($char eq $quote_start) {
+ $quoted = 1;
+ $state = 'symbol';
+ push @$tree, ['symbol', ''];
+ next;
+ }
+
+ # Symbol start
+ if ($char eq $symbol_start) {
+ push @$tree, ['symbol', ''] if $state ne 'symbol';
+ $state = 'symbol';
+ next;
+ }
+
+ # Relaxed start
+ if ($quoted && $char eq $relaxed_start) {
+
+ # Upgrade relaxed to wildcard
+ if ($state eq 'symbol') {
+ $state = 'relaxed';
+ $tree->[-1]->[0] = 'relaxed';
+ next;
+ }
+
+ }
+
+ # Wildcard start
+ if ($quoted && $char eq $wildcard_start) {
+
+ # Upgrade relaxed to wildcard
+ if ($state eq 'symbol') {
+ $state = 'wildcard';
+ $tree->[-1]->[0] = 'wildcard';
+ next;
+ }
+
+ }
+
+ # Quote end
+ if ($char eq $quote_end) {
+ $quoted = 0;
+ $state = 'text';
+ next;
+ }
+
+ # Slash
+ if ($char eq '/') {
+ push @$tree, ['slash'];
+ $state = 'text';
+ next;
+ }
+
+ # Relaxed, symbol or wildcard
+ elsif ($symbol && $char =~ /\w/) {
+ $tree->[-1]->[-1] .= $char;
+ next;
+ }
+
+ # Text
+ else {
+
+ $state = 'text';
+
+ # New text element
+ unless ($tree->[-1]->[0] eq 'text') {
+ push @$tree, ['text', $char];
+ next;
+ }
+
+ # More text
+ $tree->[-1]->[-1] .= $char;
+ }
+ }
+
+ $self->tree($tree);
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Routes::Pattern - Routes Pattern
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Routes::Pattern;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Routes::Pattern> is a container for routes pattern which are
+used to match paths against.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Routes::Pattern> implements the following attributes.
+
+=head2 C<defaults>
+
+ my $defaults = $pattern->defaults;
+ $pattern = $pattern->defaults({foo => 'bar'});
+
+Default parameters.
+
+=head2 C<pattern>
+
+ my $pattern = $pattern->pattern;
+ $pattern = $pattern->pattern('/(foo)/(bar)');
+
+Raw unparsed pattern.
+
+=head2 C<quote_end>
+
+ my $quote = $pattern->quote_end;
+ $pattern = $pattern->quote_end(']');
+
+Character indicating the end of a quoted placeholder, defaults to C<)>.
+
+=head2 C<quote_start>
+
+ my $quote = $pattern->quote_start;
+ $pattern = $pattern->quote_start('[');
+
+Character indicating the start of a quoted placeholder, defaults to C<(>.
+
+=head2 C<regex>
+
+ my $regex = $pattern->regex;
+ $pattern = $pattern->regex(qr/\/foo/);
+
+Pattern in compiled regex form.
+
+=head2 C<relaxed_start>
+
+ my $relaxed = $pattern->relaxed_start;
+ $pattern = $pattern->relaxed_start('*');
+
+Character indicating a relaxed placeholder, defaults to C<.>.
+
+=head2 C<reqs>
+
+ my $reqs = $pattern->reqs;
+ $pattern = $pattern->reqs({foo => qr/\w+/});
+
+Regex constraints.
+
+=head2 C<symbol_start>
+
+ my $symbol = $pattern->symbol_start;
+ $pattern = $pattern->symbol_start(':');
+
+Character indicating a placeholder, defaults to C<:>.
+
+=head2 C<symbols>
+
+ my $symbols = $pattern->symbols;
+ $pattern = $pattern->symbols(['foo', 'bar']);
+
+Placeholder names.
+
+=head2 C<tree>
+
+ my $tree = $pattern->tree;
+ $pattern = $pattern->tree([ ... ]);
+
+Pattern in parsed form.
+
+=head2 C<wildcard_start>
+
+ my $wildcard = $pattern->wildcard_start;
+ $pattern = $pattern->wildcard_start('*');
+
+Character indicating the start of a wildcard placeholder, defaults to C<*>.
+
+=head1 METHODS
+
+L<Mojolicious::Routes::Pattern> inherits all methods from L<Mojo::Base> and
+implements the following ones.
+
+=head2 C<new>
+
+ my $pattern = Mojolicious::Routes::Pattern->new('/:controller/:action',
+ action => qr/\w+/
+ );
+
+Construct a new pattern object.
+
+=head2 C<match>
+
+ my $result = $pattern->match('/foo/bar');
+
+Match pattern against a path.
+
+=head2 C<parse>
+
+ $pattern = $pattern->parse('/:controller/:action', action => qr/\w+/);
+
+Parse a raw pattern.
+
+=head2 C<render>
+
+ my $path = $pattern->render({action => 'foo'});
+
+Render pattern into a path with parameters.
+
+=head2 C<shape_match>
+
+ my $result = $pattern->shape_match(\$path);
+
+Match pattern against a path and remove matching parts.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,1010 @@
+package Mojolicious::Routes;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use Mojo::Exception;
+use Mojo::Loader;
+use Mojo::URL;
+use Mojo::Util 'camelize';
+use Mojolicious::Routes::Match;
+use Mojolicious::Routes::Pattern;
+use Scalar::Util 'weaken';
+
+__PACKAGE__->attr([qw/block inline parent partial/]);
+__PACKAGE__->attr([qw/children conditions/] => sub { [] });
+__PACKAGE__->attr(controller_base_class => 'Mojolicious::Controller');
+__PACKAGE__->attr(dictionary => sub { {} });
+__PACKAGE__->attr(hidden => sub { [qw/new app attr render req res stash tx/] }
+);
+__PACKAGE__->attr('namespace');
+__PACKAGE__->attr(pattern => sub { Mojolicious::Routes::Pattern->new });
+
+# Yet thanks to my trusty safety sphere,
+# I sublibed with only tribial brain dablage.
+sub new {
+ my $self = shift->SUPER::new();
+
+ # Parse
+ $self->parse(@_);
+
+ # Method condition
+ $self->add_condition(
+ method => sub {
+ my ($r, $c, $captures, $methods) = @_;
+
+ # Methods
+ return unless $methods && ref $methods eq 'ARRAY';
+
+ # Match
+ my $m = lc $c->req->method;
+ $m = 'get' if $m eq 'head';
+ for my $method (@$methods) {
+ return 1 if $method eq $m;
+ }
+
+ # Nothing
+ return;
+ }
+ );
+
+ # WebSocket condition
+ $self->add_condition(
+ websocket => sub {
+ my ($r, $c, $captures) = @_;
+
+ # WebSocket
+ return 1 if $c->tx->is_websocket;
+
+ # Not a WebSocket
+ return;
+ }
+ );
+
+ return $self;
+}
+
+sub add_child {
+ my ($self, $route) = @_;
+
+ # We are the parent
+ $route->parent($self);
+ weaken $route->{parent};
+
+ # Add to tree
+ push @{$self->children}, $route;
+
+ return $self;
+}
+
+sub add_condition {
+ my ($self, $name, $condition) = @_;
+
+ # Add
+ $self->dictionary->{$name} = $condition;
+
+ return $self;
+}
+
+sub any { shift->_generate_route(ref $_[0] ? shift : [], @_) }
+
+# Hey. What kind of party is this? There's no booze and only one hooker.
+sub auto_render {
+ my ($self, $c) = @_;
+
+ # Transaction
+ my $tx = $c->tx;
+
+ # Rendering
+ my $success = eval {
+
+ # Render
+ $c->render unless $c->stash->{'mojo.rendered'} || $tx->is_websocket;
+
+ # Success
+ 1;
+ };
+
+ # Renderer error
+ $c->render_exception($@) if !$success && $@;
+
+ # Rendered
+ return;
+}
+
+sub bridge { shift->route(@_)->inline(1) }
+
+sub del { shift->_generate_route('delete', @_) }
+
+sub detour {
+ my $self = shift;
+
+ # Partial
+ $self->partial('path');
+
+ # Defaults
+ $self->to(@_);
+
+ return $self;
+}
+
+sub dispatch {
+ my ($self, $c) = @_;
+
+ # Response
+ my $res = $c->res;
+
+ # Already rendered
+ return if $res->code;
+
+ # Path
+ my $path = $c->stash->{path};
+ $path = "/$path" if defined $path && $path !~ /^\//;
+
+ # Match
+ my $m = Mojolicious::Routes::Match->new($c, $path);
+ $m->match($self);
+ $c->match($m);
+
+ # No match
+ return 1 unless $m && @{$m->stack};
+
+ # Status
+ unless ($res->code) {
+
+ # Websocket handshake
+ $res->code(101) if !$res->code && $c->tx->is_websocket;
+
+ # Error or 200
+ my ($error, $code) = $c->req->error;
+ $res->code($code) if $code;
+ }
+
+ # Walk the stack
+ return 1 if $self->_walk_stack($c);
+
+ # Render
+ return $self->auto_render($c);
+}
+
+sub get { shift->_generate_route('get', @_) }
+
+sub hide { push @{shift->hidden}, @_ }
+
+sub is_endpoint {
+ my $self = shift;
+ return if $self->inline;
+ return 1 if $self->block;
+ return if @{$self->children};
+ return 1;
+}
+
+sub is_websocket {
+ my $self = shift;
+ return 1 if $self->{_websocket};
+ if (my $parent = $self->parent) { return $parent->is_websocket }
+ return;
+}
+
+# Dr. Zoidberg, can you note the time and declare the patient legally dead?
+# Can I! That’s my specialty!
+sub name {
+ my ($self, $name) = @_;
+
+ # New name
+ if (defined $name) {
+
+ # Generate
+ if ($name eq '*') {
+ $name = $self->pattern->pattern;
+ $name =~ s/\W+//g;
+ }
+ $self->{_name} = $name;
+
+ return $self;
+ }
+
+ return $self->{_name};
+}
+
+sub over {
+ my $self = shift;
+
+ # Shortcut
+ return $self unless @_;
+
+ # Conditions
+ my $conditions = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
+ push @{$self->conditions}, @$conditions;
+
+ return $self;
+}
+
+sub parse {
+ my $self = shift;
+
+ # Pattern does the real work
+ $self->pattern->parse(@_);
+
+ return $self;
+}
+
+sub post { shift->_generate_route('post', @_) }
+
+sub put { shift->_generate_route('put', @_) }
+
+sub render {
+ my ($self, $path, $values) = @_;
+
+ # Path prefix
+ my $prefix = $self->pattern->render($values);
+ $path = $prefix . $path unless $prefix eq '/';
+
+ # Make sure there is always a root
+ $path = '/' if !$path && !$self->parent;
+
+ # Format
+ if ((my $format = $values->{format}) && !$self->parent) {
+ $path .= ".$format" unless $path =~ /\.[^\/]+$/;
+ }
+
+ # Parent
+ $path = $self->parent->render($path, $values) if $self->parent;
+
+ return $path;
+}
+
+# Morbo forget how you spell that letter that looks like a man wearing a hat.
+# Hello, tiny man. I will destroy you!
+sub route {
+ my $self = shift;
+
+ # New route
+ my $route = $self->new(@_);
+ $self->add_child($route);
+
+ return $route;
+}
+
+sub to {
+ my $self = shift;
+
+ # Shortcut
+ return $self unless @_;
+
+ # Single argument
+ my ($shortcut, $defaults);
+ if (@_ == 1) {
+
+ # Hash
+ $defaults = shift if ref $_[0] eq 'HASH';
+ $shortcut = shift if $_[0];
+ }
+
+ # Multiple arguments
+ else {
+
+ # Odd
+ if (@_ % 2) {
+ $shortcut = shift;
+ $defaults = {@_};
+ }
+
+ # Even
+ else {
+
+ # Shortcut and defaults
+ if (ref $_[1] eq 'HASH') {
+ $shortcut = shift;
+ $defaults = shift;
+ }
+
+ # Just defaults
+ else { $defaults = {@_} }
+ }
+ }
+
+ # Shortcut
+ if ($shortcut) {
+
+ # App
+ if (ref $shortcut || $shortcut =~ /^[\w\:]+$/) {
+ $defaults->{app} = $shortcut;
+ }
+
+ # Controller and action
+ elsif ($shortcut =~ /^([\w\-]+)?\#(\w+)?$/) {
+ $defaults->{controller} = $1 if defined $1;
+ $defaults->{action} = $2 if defined $2;
+ }
+ }
+
+ # Pattern
+ my $pattern = $self->pattern;
+
+ # Defaults
+ my $old = $pattern->defaults;
+ $pattern->defaults({%$old, %$defaults}) if $defaults;
+
+ return $self;
+}
+
+sub to_string {
+ my $self = shift;
+ my $pattern = $self->parent ? $self->parent->to_string : '';
+ $pattern .= $self->pattern->pattern if $self->pattern->pattern;
+ return $pattern;
+}
+
+sub under { shift->_generate_route('under', @_) }
+
+sub via {
+ my $self = shift;
+
+ # Methods
+ my $methods = ref $_[0] ? $_[0] : [@_];
+
+ # Shortcut
+ return $self unless @$methods;
+
+ # Condition
+ push @{$self->conditions}, method => [map { lc $_ } @$methods];
+
+ return $self;
+}
+
+sub waypoint { shift->route(@_)->block(1) }
+
+sub websocket {
+ my $self = shift;
+
+ # Route
+ my $route = $self->any(@_);
+
+ # Condition
+ push @{$route->conditions}, websocket => 1;
+ $route->{_websocket} = 1;
+
+ return $route;
+}
+
+sub _dispatch_callback {
+ my ($self, $c, $staging) = @_;
+
+ # Debug
+ $c->app->log->debug(qq/Dispatching callback./);
+
+ # Dispatch
+ my $continue;
+ my $cb = $c->match->captures->{cb};
+ my $success = eval {
+
+ # Callback
+ $continue = $cb->($c);
+
+ # Success
+ 1;
+ };
+
+ # Callback error
+ if (!$success && $@) {
+ my $e = Mojo::Exception->new($@);
+ $c->app->log->error($e);
+ return $e;
+ }
+
+ # Success!
+ return 1 unless $staging;
+ return 1 if $continue;
+
+ return;
+}
+
+sub _dispatch_controller {
+ my ($self, $c, $staging) = @_;
+
+ # Application
+ my $app = $c->match->captures->{app};
+
+ # Class
+ $app ||= $self->_generate_class($c);
+ return 1 unless $app;
+
+ # Method
+ my $method = $self->_generate_method($c);
+
+ # Debug
+ my $dispatch = ref $app || $app;
+ $dispatch .= "->$method" if $method;
+ $c->app->log->debug("Dispatching $dispatch.");
+
+ # Load class
+ unless (ref $app && $self->{_loaded}->{$app}) {
+
+ # Load
+ if (my $e = Mojo::Loader->load($app)) {
+
+ # Doesn't exist
+ unless (ref $e) {
+ $c->app->log->debug("$app does not exist, maybe a typo?");
+ return;
+ }
+
+ # Error
+ $c->app->log->error($e);
+ return $e;
+ }
+
+ # Loaded
+ $self->{_loaded}->{$app}++;
+ }
+
+ # Dispatch
+ my $continue;
+ my $success = eval {
+
+ # Instantiate
+ $app = $app->new($c) unless ref $app;
+
+ # Action
+ if ($method && $app->isa($self->controller_base_class)) {
+
+ # Call action
+ $continue = $app->$method if $app->can($method);
+
+ # Merge stash
+ my $new = $app->stash;
+ @{$c->stash}{keys %$new} = values %$new;
+ }
+
+ # Handler
+ elsif ($app->isa('Mojo')) {
+
+ # Connect routes
+ if ($app->can('routes')) {
+ my $r = $app->routes;
+ unless ($r->parent) {
+ $r->parent($c->match->endpoint);
+ weaken $r->{parent};
+ }
+ }
+
+ # Handler
+ $app->handler($c);
+ }
+
+ # Success
+ 1;
+ };
+
+ # Controller error
+ if (!$success && $@) {
+ my $e = Mojo::Exception->new($@);
+ $c->app->log->error($e);
+ return $e;
+ }
+
+ # Success!
+ return 1 unless $staging;
+ return 1 if $continue;
+
+ return;
+}
+
+sub _generate_class {
+ my ($self, $c) = @_;
+
+ # Field
+ my $field = $c->match->captures;
+
+ # Class
+ my $class = $field->{class};
+ my $controller = $field->{controller} || '';
+ unless ($class) {
+ $class = $controller;
+ camelize $class;
+ }
+
+ # Namespace
+ my $namespace = $field->{namespace};
+ $namespace = $self->namespace unless defined $namespace;
+ $class = length $class ? "${namespace}::$class" : $namespace
+ if length $namespace;
+
+ # Invalid
+ return unless $class =~ /^[a-zA-Z0-9_:]+$/;
+
+ return $class;
+}
+
+sub _generate_method {
+ my ($self, $c) = @_;
+
+ # Field
+ my $field = $c->match->captures;
+
+ # Prepare hidden
+ unless ($self->{_hidden}) {
+ $self->{_hidden} = {};
+ $self->{_hidden}->{$_}++ for @{$self->hidden};
+ }
+
+ my $method = $field->{method};
+ $method ||= $field->{action};
+
+ # Shortcut
+ return unless $method;
+
+ # Shortcut for hidden methods
+ if ($self->{_hidden}->{$method} || index($method, '_') == 0) {
+ $c->app->log->debug(qq/Action "$method" is not allowed./);
+ return;
+ }
+
+ # Invalid
+ unless ($method =~ /^[a-zA-Z0-9_:]+$/) {
+ $c->app->log->debug(qq/Action "$method" is invalid./);
+ return;
+ }
+
+ return $method;
+}
+
+sub _generate_route {
+ my ($self, $methods, @args) = @_;
+
+ my ($cb, $constraints, $defaults, $name, $pattern);
+ my $conditions = [];
+
+ # Route information
+ while (defined(my $arg = shift @args)) {
+
+ # First scalar is the pattern
+ if (!ref $arg && !$pattern) { $pattern = $arg }
+
+ # Scalar
+ elsif (!ref $arg && @args) {
+ push @$conditions, $arg, shift @args;
+ }
+
+ # Last scalar is the route name
+ elsif (!ref $arg) { $name = $arg }
+
+ # Callback
+ elsif (ref $arg eq 'CODE') { $cb = $arg }
+
+ # Constraints
+ elsif (ref $arg eq 'ARRAY') { $constraints = $arg }
+
+ # Defaults
+ elsif (ref $arg eq 'HASH') { $defaults = $arg }
+ }
+
+ # Defaults
+ $constraints ||= [];
+
+ # Defaults
+ $defaults ||= {};
+ $defaults->{cb} = $cb if $cb;
+
+ # Name
+ $name ||= '';
+
+ # Create bridge
+ return $self->bridge($pattern, {@$constraints})->over($conditions)
+ ->to($defaults)->name($name)
+ if !ref $methods && $methods eq 'under';
+
+ # Create route
+ my $route =
+ $self->route($pattern, {@$constraints})->over($conditions)
+ ->via($methods)->to($defaults)->name($name);
+
+ return $route;
+}
+
+sub _walk_stack {
+ my ($self, $c) = @_;
+
+ # Stack
+ my $stack = $c->match->stack;
+
+ # Walk the stack
+ my $staging = @$stack;
+ for my $field (@$stack) {
+ $staging--;
+
+ # Stash
+ my $stash = $c->stash;
+
+ # Captures
+ $c->match->captures({%$field});
+
+ # Cleanup
+ my $cb = delete $field->{cb};
+ delete $field->{app};
+
+ # Captures
+ my $captures = $stash->{'mojo.captures'} ||= {};
+ $stash->{'mojo.captures'} = {%$captures, %$field};
+
+ # Merge in captures
+ @{$c->stash}{keys %$field} = values %$field;
+
+ # Dispatch
+ my $e =
+ $cb
+ ? $self->_dispatch_callback($c, $staging)
+ : $self->_dispatch_controller($c, $staging);
+
+ # Exception
+ if (ref $e) {
+ $c->render_exception($e);
+ return 1;
+ }
+
+ # Break the chain
+ return 1 if $staging && !$e;
+ }
+
+ # Done
+ return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Routes - Always Find Your Destination With Routes
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Routes;
+
+ # New routes tree
+ my $r = Mojolicious::Routes->new;
+
+ # Normal route matching "/articles" with parameters "controller" and
+ # "action"
+ $r->route('/articles')->to(controller => 'article', action => 'list');
+
+ # Route with a placeholder matching everything but "/" and "."
+ $r->route('/:controller')->to(action => 'list');
+
+ # Route with a placeholder and regex constraint
+ $r->route('/articles/:id', id => qr/\d+/)
+ ->to(controller => 'article', action => 'view');
+
+ # Route with an optional parameter "year"
+ $r->route('/archive/:year')
+ ->to(controller => 'archive', action => 'list', year => undef);
+
+ # Nested route for two actions sharing the same "controller" parameter
+ my $books = $r->route('/books/:id')->to(controller => 'book');
+ $books->route('/edit')->to(action => 'edit');
+ $books->route('/delete')->to(action => 'delete');
+
+ # Bridges can be used to chain multiple routes
+ $r->bridge->to(controller => 'foo', action =>'auth')
+ ->route('/blog')->to(action => 'list');
+
+ # Waypoints are similar to bridges and nested routes but can also match
+ # if they are not the actual endpoint of the whole route
+ my $b = $r->waypoint('/books')->to(controller => 'books', action => 'list');
+ $b->route('/:id', id => qr/\d+/)->to(action => 'view');
+
+ # Simplified Mojolicious::Lite style route generation is also possible
+ $r->get('/')->to(controller => 'blog', action => 'welcome');
+ my $blog = $r->under('/blog');
+ $blog->post('/list')->to('blog#list');
+ $blog->get(sub { shift->render(text => 'Go away!') });
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Routes> is a very powerful implementation of the famous routes
+pattern and the core of the L<Mojolicious> web framework.
+See L<Mojolicious::Guide::Routing> for more.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Routes> implements the following attributes.
+
+=head2 C<block>
+
+ my $block = $r->block;
+ $r = $r->block(1);
+
+Allow this route to match even if it's not an endpoint, used for waypoints.
+
+=head2 C<children>
+
+ my $children = $r->children;
+ $r = $r->children([Mojolicious::Routes->new]);
+
+The children of this routes object, used for nesting routes.
+
+=head2 C<conditions>
+
+ my $conditions = $r->conditions;
+ $r = $r->conditions([foo => qr/\w+/]);
+
+Contains condition parameters for this route, used for C<over>.
+
+=head2 C<controller_base_class>
+
+ my $base = $r->controller_base_class;
+ $r = $r->controller_base_class('Mojolicious::Controller');
+
+Base class used to identify controllers, defaults to
+L<Mojolicious::Controller>.
+
+=head2 C<dictionary>
+
+ my $dictionary = $r->dictionary;
+ $r = $r->dictionary({foo => sub { ... }});
+
+Contains all available conditions for this route.
+There are currently two conditions built in, C<method> and C<websocket>.
+
+=head2 C<hidden>
+
+ my $hidden = $r->hidden;
+ $r = $r->hidden([qw/new attr tx render req res stash/]);
+
+Controller methods and attributes that are hidden from routes.
+
+=head2 C<inline>
+
+ my $inline = $r->inline;
+ $r = $r->inline(1);
+
+Allow C<bridge> semantics for this route.
+
+=head2 C<namespace>
+
+ my $namespace = $r->namespace;
+ $r = $r->namespace('Foo::Bar::Controller');
+
+Namespace to search for controllers.
+
+=head2 C<parent>
+
+ my $parent = $r->parent;
+ $r = $r->parent(Mojolicious::Routes->new);
+
+The parent of this route, used for nesting routes.
+
+=head2 C<partial>
+
+ my $partial = $r->partial;
+ $r = $r->partial('path');
+
+Route has no specific end, remaining characters will be captured with the
+partial name.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<pattern>
+
+ my $pattern = $r->pattern;
+ $r = $r->pattern(Mojolicious::Routes::Pattern->new);
+
+Pattern for this route, by default a L<Mojolicious::Routes::Pattern> object
+and used for matching.
+
+=head1 METHODS
+
+L<Mojolicious::Routes> inherits all methods from L<Mojo::Base> and implements
+the following ones.
+
+=head2 C<new>
+
+ my $r = Mojolicious::Routes->new;
+ my $r = Mojolicious::Routes->new('/:controller/:action');
+
+Construct a new route object.
+
+=head2 C<add_child>
+
+ $r = $r->add_child(Mojolicious::Route->new);
+
+Add a new child to this route.
+
+=head2 C<add_condition>
+
+ $r = $r->add_condition(foo => sub { ... });
+
+Add a new condition for this route.
+
+=head2 C<any>
+
+ my $any = $route->any('/:foo' => sub {...});
+ my $any = $route->any([qw/get post/] => '/:foo' => sub {...});
+
+Generate route matching any of the listed HTTP request methods or all.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<auto_render>
+
+ $r->auto_render(Mojolicious::Controller->new);
+
+Automatic rendering.
+
+=head2 C<bridge>
+
+ my $bridge = $r->bridge;
+ my $bridge = $r->bridge('/:controller/:action');
+
+Add a new bridge to this route as a nested child.
+
+=head2 C<del>
+
+ my $del = $route->del('/:foo' => sub {...});
+
+Generate route matching only C<DELETE> requests.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<detour>
+
+ $r = $r->detour(action => 'foo');
+ $r = $r->detour({action => 'foo'});
+ $r = $r->detour('controller#action');
+ $r = $r->detour('controller#action', foo => 'bar');
+ $r = $r->detour('controller#action', {foo => 'bar'});
+ $r = $r->detour($app);
+ $r = $r->detour($app, foo => 'bar');
+ $r = $r->detour($app, {foo => 'bar'});
+ $r = $r->detour('MyApp');
+ $r = $r->detour('MyApp', foo => 'bar');
+ $r = $r->detour('MyApp', {foo => 'bar'});
+
+Set default parameters for this route and allow partial matching to simplify
+application embedding.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<dispatch>
+
+ my $e = $r->dispatch(Mojolicious::Controller->new);
+
+Match routes and dispatch.
+
+=head2 C<get>
+
+ my $get = $route->get('/:foo' => sub {...});
+
+Generate route matching only C<GET> requests.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<hide>
+
+ $r = $r->hide('new');
+
+Hide controller method or attribute from routes.
+
+=head2 C<is_endpoint>
+
+ my $is_endpoint = $r->is_endpoint;
+
+Returns true if this route qualifies as an endpoint.
+
+=head2 C<is_websocket>
+
+ my $is_websocket = $r->is_websocket;
+
+Returns true if this route leads to a WebSocket.
+
+=head2 C<name>
+
+ my $name = $r->name;
+ $r = $r->name('foo');
+ $r = $r->name('*');
+
+The name of this route, the special value C<*> will generate a name based on
+the route pattern.
+Note that the name C<current> is reserved for refering to the current route.
+
+=head2 C<over>
+
+ $r = $r->over(foo => qr/\w+/);
+
+Apply condition parameters to this route.
+
+=head2 C<parse>
+
+ $r = $r->parse('/:controller/:action');
+
+Parse a pattern.
+
+=head2 C<post>
+
+ my $post = $route->post('/:foo' => sub {...});
+
+Generate route matching only C<POST> requests.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<put>
+
+ my $put = $route->put('/:foo' => sub {...});
+
+Generate route matching only C<PUT> requests.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<render>
+
+ my $path = $r->render($path);
+ my $path = $r->render($path, {foo => 'bar'});
+
+Render route with parameters into a path.
+
+=head2 C<route>
+
+ my $route = $r->route('/:c/:a', a => qr/\w+/);
+
+Add a new nested child to this route.
+
+=head2 C<to>
+
+ my $to = $r->to;
+ $r = $r->to(action => 'foo');
+ $r = $r->to({action => 'foo'});
+ $r = $r->to('controller#action');
+ $r = $r->to('controller#action', foo => 'bar');
+ $r = $r->to('controller#action', {foo => 'bar'});
+ $r = $r->to($app);
+ $r = $r->to($app, foo => 'bar');
+ $r = $r->to($app, {foo => 'bar'});
+ $r = $r->to('MyApp');
+ $r = $r->to('MyApp', foo => 'bar');
+ $r = $r->to('MyApp', {foo => 'bar'});
+
+Set default parameters for this route.
+
+=head2 C<to_string>
+
+ my $string = $r->to_string;
+
+Stringifies the whole route.
+
+=head2 C<under>
+
+ my $under = $route->under(sub {...});
+ my $under = $route->under('/:foo');
+
+Generate bridges.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<via>
+
+ $r = $r->via('get');
+ $r = $r->via(qw/get post/);
+ $r = $r->via([qw/get post/]);
+
+Apply C<method> constraint to this route.
+
+=head2 C<waypoint>
+
+ my $route = $r->waypoint('/:c/:a', a => qr/\w+/);
+
+Add a waypoint to this route as nested child.
+
+=head2 C<websocket>
+
+ my $websocket = $route->websocket('/:foo' => sub {...});
+
+Generate route matching only C<WebSocket> handshakes.
+See also the L<Mojolicious::Lite> tutorial for more argument variations.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,156 @@
+package Mojolicious::Session;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use Mojo::Util qw/b64_decode b64_encode/;
+use Storable qw/freeze thaw/;
+
+__PACKAGE__->attr('cookie_domain');
+__PACKAGE__->attr(cookie_name => 'mojolicious');
+__PACKAGE__->attr(cookie_path => '/');
+__PACKAGE__->attr(default_expiration => 3600);
+
+# Bender, quit destroying the universe!
+sub load {
+ my ($self, $c) = @_;
+
+ # Session cookie
+ return unless my $value = $c->signed_cookie($self->cookie_name);
+
+ # Decode
+ b64_decode $value;
+
+ # Thaw
+ my $session = thaw $value;
+
+ # Expiration
+ return unless my $expires = delete $session->{expires};
+ return unless $expires > time;
+
+ # Content
+ my $stash = $c->stash;
+ return unless $stash->{'mojo.active_session'} = keys %$session;
+ $stash->{'mojo.session'} = $session;
+
+ # Flash
+ $session->{old_flash} = delete $session->{flash} if $session->{flash};
+}
+
+# Emotions are dumb and should be hated.
+sub store {
+ my ($self, $c) = @_;
+
+ # Session
+ my $stash = $c->stash;
+ return unless my $session = $stash->{'mojo.session'};
+ return unless keys %$session || $stash->{'mojo.active_session'};
+
+ # Flash
+ delete $session->{old_flash};
+ delete $session->{flash} unless keys %{$session->{flash}};
+
+ # Default to expiring session
+ my $expires = 1;
+ my $value = '';
+
+ # Actual session data
+ my $default = delete $session->{expires};
+ if (keys %$session) {
+
+ # Expiration
+ $expires = $session->{expires} = $default
+ ||= time + $self->default_expiration;
+
+ # Freeze
+ $value = freeze $session;
+
+ # Encode
+ b64_encode $value, '';
+ }
+
+ # Options
+ my $options = {expires => $expires, path => $self->cookie_path};
+ my $domain = $self->cookie_domain;
+ $options->{domain} = $domain if $domain;
+
+ # Session cookie
+ $c->signed_cookie($self->cookie_name, $value, $options);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Session - Signed Cookie Based Sessions
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Session;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Session> is a very simple signed cookie based session
+implementation.
+All data gets stored on the client side, but is protected from unwanted
+changes with a signature.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Session> implements the following attributes.
+
+=head2 C<cookie_domain>
+
+ my $domain = $session->cookie_domain;
+ $session = $session->cookie_domain('.example.com');
+
+Domain for session cookie, not defined by default.
+
+=head2 C<cookie_name>
+
+ my $name = $session->cookie_name;
+ $session = $session->cookie_name('session');
+
+Name of the signed cookie used to store session data, defaults to
+C<mojolicious>.
+
+=head2 C<cookie_path>
+
+ my $path = $session->cookie_path;
+ $session = $session->cookie_path('/foo');
+
+Path for session cookie, defaults to C</>.
+
+=head2 C<default_expiration>
+
+ my $time = $session->default_expiration;
+ $session = $session->default_expiration(3600);
+
+Time for the session to expire in seconds from now, defaults to C<3600>.
+The expiration timeout gets refreshed for every request.
+
+=head1 METHODS
+
+L<Mojolicious::Session> inherits all methods from L<Mojo::Base> and
+implements the following ones.
+
+=head2 C<load>
+
+ $session->load($c);
+
+Load session data from signed cookie.
+
+=head2 C<store>
+
+ $session->store($c);
+
+Store session data in signed cookie.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,266 @@
+package Mojolicious::Static;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use File::stat;
+use File::Spec;
+use Mojo::Asset::File;
+use Mojo::Asset::Memory;
+use Mojo::Command;
+use Mojo::Content::Single;
+use Mojo::Path;
+
+__PACKAGE__->attr([qw/default_static_class prefix root/]);
+
+# Valentine's Day's coming? Aw crap! I forgot to get a girlfriend again!
+sub dispatch {
+ my ($self, $c) = @_;
+
+ # Already rendered
+ return if $c->res->code;
+
+ # Canonical path
+ my $path = $c->req->url->path->clone->canonicalize->to_string;
+
+ # Prefix
+ if (my $prefix = $self->prefix) {
+ return 1 unless $path =~ s/^$prefix//;
+ }
+
+ # Parts
+ my @parts = @{Mojo::Path->new->parse($path)->parts};
+
+ # Shortcut
+ return 1 unless @parts;
+
+ # Prevent directory traversal
+ return 1 if $parts[0] eq '..';
+
+ # Serve static file
+ unless ($self->serve($c, join('/', @parts))) {
+
+ # Resume
+ $c->tx->resume;
+
+ return;
+ }
+
+ return 1;
+}
+
+sub serve {
+ my ($self, $c, $rel) = @_;
+
+ # Append path to root
+ my $path = File::Spec->catfile($self->root, split('/', $rel));
+
+ # Extension
+ $path =~ /\.(\w+)$/;
+ my $ext = $1;
+
+ # Type
+ my $type = $c->app->types->type($ext) || 'text/plain';
+
+ # Response
+ my $res = $c->res;
+
+ # Asset
+ my $asset;
+
+ # Modified
+ my $modified = $self->{_modified} ||= time;
+
+ # Size
+ my $size = 0;
+
+ # File
+ if (-f $path) {
+
+ # Readable
+ if (-r $path) {
+
+ # Modified
+ my $stat = stat($path);
+ $modified = $stat->mtime;
+
+ # Size
+ $size = $stat->size;
+
+ # Content
+ $asset = Mojo::Asset::File->new(path => $path);
+ }
+
+ # Exists, but is forbidden
+ else {
+ $c->app->log->debug('File forbidden.');
+ $res->code(403) and return;
+ }
+ }
+
+ # Inline file
+ elsif (defined(my $file = $self->_get_inline_file($c, $rel))) {
+ $size = length $file;
+ $asset = Mojo::Asset::Memory->new->add_chunk($file);
+ }
+
+ # Found
+ if ($asset) {
+
+ # Log
+ $c->app->log->debug(qq/Serving static file "$rel"./);
+
+ # Request
+ my $req = $c->req;
+
+ # Request headers
+ my $rqh = $req->headers;
+
+ # Response headers
+ my $rsh = $res->headers;
+
+ # If modified since
+ if (my $date = $rqh->if_modified_since) {
+
+ # Not modified
+ my $since = Mojo::Date->new($date)->epoch;
+ if (defined $since && $since == $modified) {
+ $c->app->log->debug('File not modified.');
+ $res->code(304);
+ $rsh->remove('Content-Type');
+ $rsh->remove('Content-Length');
+ $rsh->remove('Content-Disposition');
+ return;
+ }
+ }
+
+ # Start and end
+ my $start = 0;
+ my $end = $size - 1 >= 0 ? $size - 1 : 0;
+
+ # Range
+ if (my $range = $rqh->range) {
+ if ($range =~ m/^bytes=(\d+)\-(\d+)?/ && $1 <= $end) {
+ $start = $1;
+ $end = $2 if defined $2 && $2 <= $end;
+ $res->code(206);
+ $rsh->content_length($end - $start + 1);
+ $rsh->content_range("bytes $start-$end/$size");
+ $c->app->log->debug("Range request: $start-$end/$size.");
+ }
+ else {
+
+ # Not satisfiable
+ $res->code(416);
+ return;
+ }
+ }
+ $asset->start_range($start);
+ $asset->end_range($end);
+
+ # Response
+ $res->code(200) unless $res->code;
+ $res->content->asset($asset);
+ $rsh->content_type($type);
+ $rsh->accept_ranges('bytes');
+ $rsh->last_modified(Mojo::Date->new($modified));
+ return;
+ }
+
+ return 1;
+}
+
+sub _get_inline_file {
+ my ($self, $c, $rel) = @_;
+
+ # Protect templates
+ return if $rel =~ /\.\w+\.\w+$/;
+
+ # Class
+ my $class =
+ $c->stash->{static_class}
+ || $ENV{MOJO_STATIC_CLASS}
+ || $self->default_static_class
+ || 'main';
+
+ # Inline files
+ my $inline = $self->{_inline_files}->{$class};
+ unless ($inline) {
+ my $files = Mojo::Command->new->get_all_data($class) || {};
+ $inline = $self->{_inline_files}->{$class} = [keys %$files];
+ }
+
+ # Find
+ for my $path (@$inline) {
+ return Mojo::Command->new->get_data($path, $class) if $path eq $rel;
+ }
+
+ # Nothing
+ return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Static - Serve Static Files
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Static;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Static> is a dispatcher for static files with C<Range> and
+C<If-Modified-Since> support.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Static> implements the following attributes.
+
+=head2 C<default_static_class>
+
+ my $class = $static->default_static_class;
+ $static = $static->default_static_class('main');
+
+The dispatcher will use this class to look for files in the C<DATA> section.
+
+=head2 C<prefix>
+
+ my $prefix = $static->prefix;
+ $static = $static->prefix('/static');
+
+Prefix path to remove from incoming paths before dispatching.
+
+=head2 C<root>
+
+ my $root = $static->root;
+ $static = $static->root('/foo/bar/files');
+
+Directory to serve static files from.
+
+=head1 METHODS
+
+L<Mojolicious::Static> inherits all methods from L<Mojo::Base>
+and implements the following ones.
+
+=head2 C<dispatch>
+
+ my $success = $static->dispatch($c);
+
+Dispatch a L<Mojolicious::Controller> object.
+
+=head2 C<serve>
+
+ my $success = $static->serve($c, 'foo/bar.html');
+
+Serve a specific file.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,92 @@
+package Mojolicious::Types;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+# Once again, the conservative, sandwich-heavy portfolio pays off for the
+# hungry investor.
+__PACKAGE__->attr(
+ types => sub {
+ return {
+ atom => 'application/atom+xml',
+ bin => 'application/octet-stream',
+ css => 'text/css',
+ gif => 'image/gif',
+ gz => 'application/gzip',
+ htm => 'text/html',
+ html => 'text/html',
+ ico => 'image/x-icon',
+ jpeg => 'image/jpeg',
+ jpg => 'image/jpeg',
+ js => 'application/x-javascript',
+ json => 'application/json',
+ mp3 => 'audio/mpeg',
+ png => 'image/png',
+ rss => 'application/rss+xml',
+ svg => 'image/svg+xml',
+ tar => 'application/x-tar',
+ txt => 'text/plain',
+ xml => 'text/xml',
+ zip => 'application/zip'
+ };
+ }
+);
+
+# Magic. Got it.
+sub type {
+ my ($self, $ext, $type) = @_;
+
+ # Set
+ if ($type) {
+ $self->types->{$ext} = $type;
+ return $self;
+ }
+
+ return $self->types->{$ext || ''};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojolicious::Types - MIME Types
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Types;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Types> is a container for MIME types.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Types> implements the following attributes.
+
+=head2 C<types>
+
+ my $map = $types->types;
+ $types = $types->types({png => 'image/png'});
+
+List of MIME types.
+
+=head1 METHODS
+
+L<Mojolicious::Types> inherits all methods from L<Mojo::Base> and implements the
+following ones.
+
+=head2 C<type>
+
+ my $type = $types->type('png');
+ $types = $types->type(png => 'image/png');
+
+Get or set MIME type for file extension.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -8,17 +8,17 @@ use base 'Mojo';
use Carp 'croak';
use Mojolicious::Commands;
use Mojolicious::Plugins;
-use MojoX::Dispatcher::Routes;
-use MojoX::Dispatcher::Static;
-use MojoX::Renderer;
-use MojoX::Session::Cookie;
-use MojoX::Types;
+use Mojolicious::Renderer;
+use Mojolicious::Routes;
+use Mojolicious::Session;
+use Mojolicious::Static;
+use Mojolicious::Types;
__PACKAGE__->attr(controller_class => 'Mojolicious::Controller');
__PACKAGE__->attr(mode => sub { ($ENV{MOJO_MODE} || 'development') });
__PACKAGE__->attr(plugins => sub { Mojolicious::Plugins->new });
-__PACKAGE__->attr(renderer => sub { MojoX::Renderer->new });
-__PACKAGE__->attr(routes => sub { MojoX::Dispatcher::Routes->new });
+__PACKAGE__->attr(renderer => sub { Mojolicious::Renderer->new });
+__PACKAGE__->attr(routes => sub { Mojolicious::Routes->new });
__PACKAGE__->attr(
secret => sub {
my $self = shift;
@@ -30,14 +30,12 @@ __PACKAGE__->attr(
return ref $self;
}
);
-__PACKAGE__->attr(session => sub { MojoX::Session::Cookie->new });
-__PACKAGE__->attr(static => sub { MojoX::Dispatcher::Static->new });
-__PACKAGE__->attr(types => sub { MojoX::Types->new });
+__PACKAGE__->attr(session => sub { Mojolicious::Session->new });
+__PACKAGE__->attr(static => sub { Mojolicious::Static->new });
+__PACKAGE__->attr(types => sub { Mojolicious::Types->new });
our $CODENAME = 'Hot Beverage';
-our $VERSION = '0.999936';
-
-our $AUTOLOAD;
+our $VERSION = '0.999950';
# These old doomsday devices are dangerously unstable.
# I'll rest easier not knowing where they are.
@@ -45,7 +43,7 @@ sub AUTOLOAD {
my $self = shift;
# Method
- my ($package, $method) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
+ my ($package, $method) = our $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
# Helper
croak qq/Can't locate object method "$method" via "$package"/
@@ -99,10 +97,6 @@ sub new {
# Static
my $static = $self->static;
- # Types
- $renderer->types($self->types);
- $static->types($self->types);
-
# Home
my $home = $self->home;
@@ -362,8 +356,8 @@ magic and no requirements besides Perl 5.8.7.
=item *
-Full stack HTTP 1.1 and WebSocket client/server implementation with IPv6,
-TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
+Full stack HTTP 1.1 and WebSocket client/server implementation with TLS,
+Bonjour, IDNA, Comet (long polling), chunking and multipart support.
=item *
@@ -426,9 +420,6 @@ Web development for humans, making hard things possible and everything fun.
The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
<% end %>
-For more user friendly documentation see L<Mojolicious::Guides> and
-L<Mojolicious::Lite>.
-
=head2 Have Some Cake
Loosely coupled building blocks, use what you like and just ignore the rest.
@@ -449,11 +440,67 @@ Loosely coupled building blocks, use what you like and just ignore the rest.
| CGI | | FastCGI | | PSGI | | HTTP 1.1 | | WebSocket |
'-------' '-----------' '--------' '------------' '-------------'
-=head2 Installation
+=head2 Highlights
+
+These are some of the most important building blocks of L<Mojolicious>.
+
+=over 4
+
+=item L<Mojolicious::Lite>
+
+Micro Web Framework built on top of L<Mojolicious> for prototypes and small
+applications.
+
+=item L<Mojo::Client>
+
+Full featured async io HTTP 1.1 and WebSocket client.
+
+=item L<Mojo::DOM>
+
+Very fun and minimalistic XML/HTML5 DOM parser with CSS3 selector support.
+
+=item L<Mojo::JSON>
+
+Minimalistic JSON implementation that just works.
+
+=item L<Mojo::Server::Daemon>
+
+Highly portable async io HTTP 1.1 and WebSocket server, perfect for
+development and testing.
+
+=item L<Mojo::Server::Hypnotoad>
+
+Full featured UNIX optimized preforking async io HTTP 1.1 and WebSocket
+server with support for zero downtime software upgrades (hot deployment).
-All you need is a oneliner.
+=item L<Mojo::Server::CGI>, L<Mojo::Server::FastCGI>, L<Mojo::Server::PSGI>
- curl -L cpanmin.us | perl - http://latest.mojolicio.us
+Transparent CGI, FastCGI and PSGI support out of the box.
+
+=item L<Mojo::Template>
+
+Very perlish and minimalistic template system.
+
+=item L<Mojo::ByteStream>
+
+Countless portable and very convenient bytestream manipulation methods.
+
+=item L<Mojolicious::Commands>
+
+Pluggable command line system and the backbone of the C<mojo> script.
+
+=item L<Test::Mojo>
+
+Test driven development toolkit for web applications.
+
+=item L<ojo>
+
+Fun oneliners using everything above.
+
+=back
+
+For more documentation see L<Mojolicious::Guides> and the tutorial in
+L<Mojolicious::Lite>!
=head1 ATTRIBUTES
@@ -502,19 +549,19 @@ write a plugin.
=head2 C<renderer>
my $renderer = $app->renderer;
- $app = $app->renderer(MojoX::Renderer->new);
+ $app = $app->renderer(Mojolicious::Renderer->new);
-Used in your application to render content, by default a L<MojoX::Renderer>
-object.
+Used in your application to render content, by default a
+L<Mojolicious::Renderer> object.
The two main renderer plugins L<Mojolicious::Plugin::EpRenderer> and
L<Mojolicious::Plugin::EplRenderer> contain more specific information.
=head2 C<routes>
my $routes = $app->routes;
- $app = $app->routes(MojoX::Dispatcher::Routes->new);
+ $app = $app->routes(Mojolicious::Routes->new);
-The routes dispatcher, by default a L<MojoX::Dispatcher::Routes> object.
+The routes dispatcher, by default a L<Mojolicious::Routes> object.
You use this in your startup method to define the url endpoints for your
application.
@@ -535,21 +582,29 @@ application name which is not very secure, so you should change it!!!
As long as you are using the unsecure default there will be debug messages in
the log file reminding you to change your passphrase.
+=head2 C<session>
+
+ my $session = $app->session;
+ $app = $app->session(Mojolicious::Session->new);
+
+Simple singed cookie based sessions, by default a L<Mojolicious::Session>
+object.
+
=head2 C<static>
my $static = $app->static;
- $app = $app->static(MojoX::Dispatcher::Static->new);
+ $app = $app->static(Mojolicious::Static->new);
For serving static assets from your C<public> directory, by default a
-L<MojoX::Dispatcher::Static> object.
+L<Mojolicious::Static> object.
=head2 C<types>
my $types = $app->types;
- $app = $app->types(MojoX::Types->new);
+ $app = $app->types(Mojolicious::Types->new);
Responsible for tracking the types of content you want to serve in your
-application, by default a L<MojoX::Types> object.
+application, by default a L<Mojolicious::Types> object.
You can easily register new types.
$app->types->type(vti => 'help/vampire');
@@ -600,7 +655,8 @@ Sets up the default controller and calls process for every request.
$app->helper(foo => sub { ... });
-Add a new helper.
+Add a new helper that will be available as a method of the controller object
+and the application object, as well as a function in C<ep> templates.
Note that this method is EXPERIMENTAL and might change without warning!
# Helper
@@ -63,7 +63,7 @@ sub _request {
# Error
my ($message, $code) = $tx->error;
- warn qq/Couldn't open URL "$_[0]". ($message)\n/ if $message && !$code;
+ warn qq/Problem loading URL "$_[0]". ($message)\n/ if $message && !$code;
return $tx->res;
}
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use File::Basename 'dirname';
+use File::Spec;
+
+use lib join '/', File::Spec->splitdir(dirname(__FILE__)), 'lib';
+use lib join '/', File::Spec->splitdir(dirname(__FILE__)), '..', 'lib';
+
+# Check if Mojo is installed
+eval 'use Mojo::Server::Hypnotoad';
+die <<EOF if $@;
+It looks like you don't have the Mojolicious Framework installed.
+Please visit http://mojolicious.org for detailed installation instructions.
+
+EOF
+
+use Getopt::Long 'GetOptions';
+
+# Hypnotoad
+my $toad = Mojo::Server::Hypnotoad->new;
+
+# Config
+my $config = 'hypnotoad.conf';
+
+# Options
+my $help;
+GetOptions(
+ 'config=s' => sub { $config = $_[1] },
+ foreground => sub { $ENV{HYPNOTOAD_FOREGROUND} = 1 },
+ help => sub { $help = 1 },
+ test => sub { $ENV{HYPNOTOAD_TEST} = 1 },
+);
+
+# Application
+$help = 1 unless my $app = shift || $ENV{HYPNOTOAD_APP};
+
+# Usage
+die <<"EOF" if $help;
+usage: $0 [OPTIONS] [APPLICATION]
+
+ hypnotoad script/myapp
+ hypnotoad myapp.pl
+
+These options are available:
+ --config <path> Configuration file, defaults to "hypnotoad.conf" in the
+ same directory as the application script.
+ --foreground Keep manager process in foreground.
+ --help Show this message.
+ --test Test application/configuration and exit.
+EOF
+
+# Start
+$toad->run($app, $config);
+
+__END__
+
+=head1 NAME
+
+hypnotoad - Hypnotoad HTTP 1.1 And WebSocket Server
+
+=head1 SYNOPSIS
+
+ hypnotoad myapp.pl
+
+=head1 DESCRIPTION
+
+Start L<Mojolicious> and L<Mojolicious::Lite> applications with the
+L<Mojo::Server::Hypnotoad> web server.
+
+Note that this script is EXPERIMENTAL and might change without warning!
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -26,6 +26,15 @@ __END__
mojo - The Mojolicious Command System
+=head1 SYNOPSIS
+
+ mojo help
+
+=head1 DESCRIPTION
+
+List and run L<Mojolicious> commands as described in
+L<Mojolicious::Commands>.
+
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More;
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More;
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 43;
@@ -21,7 +21,7 @@ package main;
use strict;
use warnings;
-use Test::More tests => 404;
+use Test::More tests => 405;
# I've done everything the Bible says,
# even the stuff that contradicts the other stuff!
@@ -39,6 +39,12 @@ for my $i (51 .. 100) {
is $monkeys->[$i]->bananas, $i, 'right attribute value';
}
+# Instance method
+my $monkey = BaseTest->new;
+$monkey->attr('mojo');
+$monkey->mojo(23);
+is $monkey->mojo, 23, 'monkey has mojo';
+
# "default" defined but false
my $m = $monkeys->[1];
ok defined($m->figs);
@@ -12,7 +12,7 @@ use Test::More;
plan skip_all => 'Perl 5.10 required for this test!'
unless eval { require Digest::SHA; 1 };
-plan tests => 64;
+plan tests => 65;
use_ok 'Mojo::ByteStream', 'b';
@@ -54,6 +54,11 @@ $stream = b("Zm9vw5/EgGJhciUyM+KYug==\n")->b64_decode->decode('UTF-8');
is "$stream", "foo\x{df}\x{0100}bar%23\x{263a}",
'right base64 decoded result';
+# utf8 b64_decode
+$stream = b("Zm9vw5/EgGJhciUyM+KYug==\n")->b64_decode->decode;
+is "$stream", "foo\x{df}\x{0100}bar%23\x{263a}",
+ 'right base64 decoded result';
+
# b64_encode (custom line ending)
$stream = b('foobar$%^&3217');
is $stream->b64_encode(''),
@@ -3,10 +3,12 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
-use Test::More tests => 47;
+use Test::More;
+plan skip_all => 'Windows is too fragile for this test!' if $^O eq 'MSWin32';
+plan tests => 51;
use_ok 'Mojo::Client';
@@ -81,27 +83,53 @@ ok $tx->success, 'successful';
is $tx->res->code, 200, 'right status';
is $tx->res->body, 'works', 'right content';
+# GET / (custom connection)
+my ($success, $code, $body);
+$client->ioloop->connect(
+ address => 'localhost',
+ port => $port,
+ on_connect => sub {
+ my ($loop, $id) = @_;
+ my $tx = $client->build_tx(GET => "http://mojolicio.us:$port/");
+ $tx->connection($id);
+ $client->start(
+ $tx => sub {
+ my $self = shift;
+ $self->ioloop->drop($id);
+ $success = $self->tx->success;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+ );
+ }
+);
+$client->ioloop->start;
+ok $success, 'successful';
+is $code, 200, 'right status';
+is $body, 'works!', 'right content';
+
# GET / (missing Content-Lengt header)
$tx = $client->get("http://localhost:$port2/");
-ok $tx->success, 'successful';
+ok !$tx->success, 'not successful';
+is $tx->error, 'Interrupted, maybe a timeout?', 'right error';
is $tx->kept_alive, undef, 'kept connection not alive';
-is $tx->keep_alive, 0, 'keep connection not alive';
+is $tx->keep_alive, 0, 'keep connection not alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works too!', 'no content';
+is $tx->res->body, 'works too!', 'right content';
# GET / (mock server)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# GET / (mock server again)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, 1, 'kept connection alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# Close connection (bypassing safety net)
$client->ioloop->_drop_immediately($last);
@@ -111,14 +139,14 @@ $tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# GET / (mock server again)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, 1, 'kept connection alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# Close connection (bypassing safety net)
$client->ioloop->_drop_immediately($last);
@@ -128,45 +156,41 @@ $tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# GET / (mock server again)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, 1, 'kept connection alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
-# Taint connection (on UNIX)
-$^O eq 'MSWin32'
- ? $client->ioloop->_drop_immediately($last)
- : $client->ioloop->write($last => 'broken!');
+# Taint connection
+$client->ioloop->write($last => 'broken!');
# GET / (mock server tainted connection)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# GET / (mock server again)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, 1, 'kept connection alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
-# Taint connection (on UNIX)
-$^O eq 'MSWin32'
- ? $client->ioloop->_drop_immediately($last)
- : $client->ioloop->write($last => 'broken!');
+# Taint connection
+$client->ioloop->write($last => 'broken!');
# GET / (mock server tainted connection)
$tx = $client->get("http://localhost:$port/mock");
ok $tx->success, 'successful';
is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
-is $tx->res->body, 'works!', 'no content';
+is $tx->res->body, 'works!', 'right content';
# Nested keep alive
my @kept_alive;
@@ -3,14 +3,14 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_NO_TLS} = 1 }
+# Disable epoll, kqueue and TLS
+BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_TLS} = 1 }
use Test::More;
-plan skip_all => 'set TEST_CLIENT to enable this test (developer only!)'
- unless $ENV{TEST_CLIENT};
-plan tests => 102;
+plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
+ unless $ENV{TEST_ONLINE};
+plan tests => 101;
# So then I said to the cop, "No, you're driving under the influence...
# of being a jerk".
@@ -75,19 +75,6 @@ $async->get(
$async->ioloop->start;
is $kept_alive, 1, 'connection was kept alive';
-# Resolve TXT record
-my $record;
-$async->ioloop->resolve(
- 'google.com',
- 'TXT',
- sub {
- my ($self, $records) = @_;
- $record = $records->[0];
- $self->stop;
- }
-)->start;
-like $record, qr/spf/, 'right record';
-
# Nested keep alive
my @kept_alive;
$client->async->get(
@@ -0,0 +1,173 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
+
+use Test::More;
+
+# I ate the blue ones... they taste like burning.
+use File::Spec;
+use File::Temp;
+use FindBin;
+use IO::Socket::INET;
+use Mojo::Client;
+use Mojo::IOLoop;
+use Mojo::Template;
+use Mojo::Transaction::HTTP;
+
+plan skip_all => 'set TEST_HYPNOTOAD to enable this test (developer only!)'
+ unless $ENV{TEST_HYPNOTOAD};
+plan tests => 40;
+
+# Daddy, I'm scared. Too scared to even wet my pants.
+# Just relax and it'll come, son.
+use_ok 'Mojo::Server::Hypnotoad';
+
+# Config
+my $dir = File::Temp::tempdir(CLEANUP => 1);
+my $config = File::Spec->catfile($dir, 'hypnotoad.conf');
+my $port = Mojo::IOLoop->generate_port;
+my $mt = Mojo::Template->new;
+$mt->render_to_file(<<'EOF', $config, $port);
+% my $port = shift;
+{listen => "http://*:<%= $port %>"};
+EOF
+
+# Start
+my $prefix = "$FindBin::Bin/../../script";
+my $pid = open my $server, '-|', $^X, "$prefix/hypnotoad", '--foreground',
+ '--config',
+ $config, "$prefix/mojo";
+sleep 1
+ while !IO::Socket::INET->new(
+ Proto => 'tcp',
+ PeerAddr => 'localhost',
+ PeerPort => $port
+ );
+
+my $client = Mojo::Client->new;
+
+# Single request without keep alive
+my $tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/0/");
+$tx->req->headers->connection('close');
+$client->start($tx);
+ok $tx->is_done, 'transaction is done';
+is $tx->res->code, 200, 'right status';
+like $tx->res->headers->connection, qr/close/i, 'right "Connection" header';
+like $tx->res->body, qr/Mojo/, 'right content';
+
+# Multiple requests
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/1/");
+my $tx2 = Mojo::Transaction::HTTP->new;
+$tx2->req->method('GET');
+$tx2->req->url->parse("http://127.0.0.1:$port/2/");
+$tx2->req->headers->expect('fun');
+$tx2->req->body('foo bar baz');
+my $tx3 = Mojo::Transaction::HTTP->new;
+$tx3->req->method('GET');
+$tx3->req->url->parse("http://127.0.0.1:$port/3/");
+my $tx4 = Mojo::Transaction::HTTP->new;
+$tx4->req->method('GET');
+$tx4->req->url->parse("http://127.0.0.1:$port/4/");
+$client->start($tx, $tx2, $tx3, $tx4);
+ok $tx->is_done, 'transaction is done';
+ok $tx2->is_done, 'transaction is done';
+ok $tx3->is_done, 'transaction is done';
+ok $tx4->is_done, 'transaction is done';
+is $tx->res->code, 200, 'right status';
+is $tx2->res->code, 200, 'right status';
+is $tx3->res->code, 200, 'right status';
+is $tx4->res->code, 200, 'right status';
+like $tx2->res->content->asset->slurp, qr/Mojo/, 'right content';
+
+# Request
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/5/");
+$tx->req->headers->expect('fun');
+$tx->req->body('Hello Mojo!');
+$client->start($tx);
+is $tx->res->code, 200, 'right status';
+like $tx->res->headers->connection, qr/Keep-Alive/i,
+ 'right "Connection" header';
+like $tx->res->body, qr/Mojo/, 'right content';
+
+# Second keep alive request
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/6/");
+$client->start($tx);
+is $tx->res->code, 200, 'right status';
+is $tx->kept_alive, 1, 'connection was alive';
+like $tx->res->headers->connection,
+ qr/Keep-Alive/i, 'right "Connection" header';
+like $tx->res->body, qr/Mojo/, 'right content';
+
+# Third keep alive request
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/7/");
+$client->start($tx);
+is $tx->res->code, 200, 'right status';
+is $tx->kept_alive, 1, 'connection was kept alive';
+like $tx->res->headers->connection,
+ qr/Keep-Alive/i, 'right "Connection" header';
+like $tx->res->body, qr/Mojo/, 'right content';
+
+# Multiple requests
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/8/");
+$tx2 = Mojo::Transaction::HTTP->new;
+$tx2->req->method('GET');
+$tx2->req->url->parse("http://127.0.0.1:$port/9/");
+$client->start($tx, $tx2);
+ok $tx->is_done, 'transaction is done';
+ok $tx2->is_done, 'transaction is done';
+is $tx->res->code, 200, 'right status';
+is $tx2->res->code, 200, 'right status';
+like $tx2->res->content->asset->slurp, qr/Mojo/, 'right content';
+
+# Multiple requests with a chunked response
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse("http://127.0.0.1:$port/10/");
+$tx2 = Mojo::Transaction::HTTP->new;
+$tx2->req->method('GET');
+$tx2->req->url->parse("http://127.0.0.1:$port/11/");
+$tx2->req->headers->expect('fun');
+$tx2->req->body('foo bar baz');
+$tx3 = Mojo::Transaction::HTTP->new;
+$tx3->req->method('GET');
+$tx3->req->url->parse(
+ "http://127.0.0.1:$port/diag/chunked_params?a=foo&b=12");
+$tx4 = Mojo::Transaction::HTTP->new;
+$tx4->req->method('GET');
+$tx4->req->url->parse("http://127.0.0.1:$port/13/");
+$client->start($tx, $tx2, $tx3, $tx4);
+ok $tx->is_done, 'transaction is done';
+ok $tx2->is_done, 'transaction is done';
+ok $tx3->is_done, 'transaction is done';
+ok $tx4->is_done, 'transaction is done';
+is $tx->res->code, 200, 'right status';
+is $tx2->res->code, 200, 'right status';
+is $tx3->res->code, 200, 'right status';
+is $tx4->res->code, 200, 'right status';
+like $tx2->res->content->asset->slurp, qr/Mojo/, 'right content';
+is $tx3->res->content->asset->slurp, 'foo12', 'right content';
+
+# Stop
+kill $^O eq 'MSWin32' ? 'KILL' : 'INT', $pid;
+sleep 1
+ while IO::Socket::INET->new(
+ Proto => 'tcp',
+ PeerAddr => 'localhost',
+ PeerPort => $port
+ );
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 7;
use_ok 'Mojo::IOLoop';
@@ -15,7 +15,7 @@ my $loop = Mojo::IOLoop->new;
# Ticks
my $ticks = 0;
-$loop->on_tick(sub { $ticks++ });
+my $id = $loop->on_tick(sub { $ticks++ });
# Timer
my $flag = 0;
@@ -58,3 +58,13 @@ ok $ticks > 2, 'more than two ticks';
# Idle callback
is $idle, 1, 'on_idle was called';
+
+# Run again without first tick event handler
+my $before = $ticks;
+my $after = 0;
+$loop->on_tick(sub { $after++ });
+$loop->drop($id);
+$loop->timer(1 => sub { shift->stop });
+$loop->start;
+ok $after > 2, 'more than two ticks';
+is $ticks, $before, 'no additional ticks';
@@ -0,0 +1,144 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
+
+use Test::More;
+plan skip_all => 'Perl 5.12 required for this test!'
+ unless eval 'use 5.012000; 1';
+plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
+ unless $ENV{TEST_ONLINE};
+plan tests => 10;
+
+use_ok 'Mojo::IOLoop';
+
+use List::Util 'first';
+use Mojo::URL;
+
+# Your guilty consciences may make you vote Democratic, but secretly you all
+# yearn for a Republican president to lower taxes, brutalize criminals, and
+# rule you like a king!
+my $loop = Mojo::IOLoop->new;
+
+# Resolve all record
+my %types;
+$loop->resolve(
+ 'www.google.com',
+ '*',
+ sub {
+ my ($self, $records) = @_;
+ $types{$_->[0]}++ for @$records;
+ $self->stop;
+ }
+)->start;
+ok keys %types > 1, 'multiple record types';
+
+# Resolve TXT record
+my $result;
+$loop->resolve(
+ 'google.com',
+ 'TXT',
+ sub {
+ my ($self, $records) = @_;
+ $result = (first { $_->[0] eq 'TXT' } @$records)->[1];
+ $self->stop;
+ }
+)->start;
+like $result, qr/spf/, 'right record';
+
+# Resolve NS records
+my $found = 0;
+$loop->resolve(
+ 'gmail.com',
+ 'NS',
+ sub {
+ my ($self, $records) = @_;
+ $found++ if first { $_->[1] =~ /ns\d*.google\.com/ } @$records;
+ $self->stop;
+ }
+)->start;
+ok $found, 'found NS records';
+
+# Resolve AAAA record
+$result = undef;
+$loop->resolve(
+ 'ipv6.google.com',
+ 'AAAA',
+ sub {
+ my ($self, $records) = @_;
+ $result = (first { $_->[0] eq 'AAAA' } @$records)->[1];
+ $self->stop;
+ }
+)->start;
+like $result, $Mojo::URL::IPV6_RE, 'valid IPv6 record';
+
+# Resolve CNAME record
+$result = undef;
+$loop->resolve(
+ 'ipv6.google.com',
+ 'CNAME',
+ sub {
+ my ($self, $records) = @_;
+ $result = (first { $_->[0] eq 'CNAME' } @$records)->[1];
+ $self->stop;
+ }
+)->start;
+is $result, 'ipv6.l.google.com', 'right CNAME record';
+
+# Resolve MX records
+$found = 0;
+$loop->resolve(
+ 'gmail.com',
+ 'MX',
+ sub {
+ my ($self, $records) = @_;
+ $found++
+ if first { $_->[1] =~ /gmail-smtp-in\.l\.google\.com/ } @$records;
+ $self->stop;
+ }
+)->start;
+ok $found, 'found MX records';
+
+# Resolve A record and perform PTR roundtrip
+my ($a1, $ptr, $a2);
+$loop->resolve(
+ 'perl.org',
+ 'A',
+ sub {
+ my ($self, $records) = @_;
+ $a1 = (first { $_->[0] eq 'A' } @$records)->[1];
+ $self->resolve(
+ $a1, 'PTR',
+ sub {
+ my ($self, $records) = @_;
+ $ptr = $records->[0]->[1];
+ $self->resolve(
+ $ptr, 'A',
+ sub {
+ my ($self, $records) = @_;
+ $a2 = (first { $_->[0] eq 'A' } @$records)->[1];
+ $self->stop;
+ }
+ );
+ }
+ );
+ }
+)->start;
+like $a1, $Mojo::URL::IPV4_RE, 'valid IPv4 record';
+is $a1, $a2, 'PTR roundtrip succeeded';
+
+# Resolve PTR record (IPv6)
+$found = 0;
+$loop->resolve(
+ '2001:4f8:0:2:0:0:0:e',
+ 'PTR',
+ sub {
+ my ($self, $records) = @_;
+ $found++ if first { $_->[1] eq 'freebsd.isc.org' } @$records;
+ $self->stop;
+ }
+)->start;
+ok $found, 'found IPv6 PTR record';
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
+
+use Test::More;
+use Mojo::IOLoop;
+plan skip_all => 'IO::Socket::SSL 1.34 required for this test!'
+ unless Mojo::IOLoop::TLS;
+plan tests => 2;
+
+# To the panic room!
+# We don't have a panic room.
+# To the panic room store!
+my $loop = Mojo::IOLoop->new;
+my $port = Mojo::IOLoop->generate_port;
+my $server = '';
+my $client = '';
+$loop->listen(
+ port => $port,
+ tls => 1,
+ on_accept => sub {
+ shift->write(shift, 'test', sub { shift->write(shift, '321') });
+ },
+ on_read => sub { $server .= pop },
+ on_hup => sub { $server .= 'hup' }
+);
+my $c = $loop->connect(
+ address => 'localhost',
+ port => $port,
+ tls => 1,
+ on_connect => sub {
+ shift->write(shift, 'tset', sub { shift->write(shift, '123') });
+ },
+ on_read => sub { $client .= pop },
+ on_hup => sub { shift->stop }
+);
+$loop->connection_timeout($c => '0.5');
+$loop->start;
+is $server, 'tset123hup', 'right content';
+is $client, 'test321', 'right content';
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 97;
+use Test::More tests => 102;
use Mojo::ByteStream 'b';
@@ -23,8 +23,10 @@ $array = $json->decode('[0]');
is_deeply $array, [0], 'decode [0]';
$array = $json->decode('[1]');
is_deeply $array, [1], 'decode [1]';
-$array = $json->decode('[ -122.026020 ]');
+$array = $json->decode('[ "-122.026020" ]');
is_deeply $array, ['-122.026020'], 'decode [ -122.026020 ]';
+$array = $json->decode('[ -122.026020 ]');
+is_deeply $array, ['-122.02602'], 'decode [ -122.026020 ]';
$array = $json->decode('[0.0]');
isa_ok $array, 'ARRAY', 'decode [0.0]';
cmp_ok $array->[0], '==', 0, 'value is 0';
@@ -33,8 +35,10 @@ isa_ok $array, 'ARRAY', 'decode [0e0]';
cmp_ok $array->[0], '==', 0, 'value is 0';
$array = $json->decode('[1,-2]');
is_deeply $array, [1, -2], 'decode [1,-2]';
+$array = $json->decode('["10e12" , [2 ]]');
+is_deeply $array, ['10e12', [2]], 'decode ["10e12" , [2 ]]';
$array = $json->decode('[10e12 , [2 ]]');
-is_deeply $array, ['10e12', [2]], 'decode [10e12 , [2 ]]';
+is_deeply $array, [10000000000000, [2]], 'decode [10e12 , [2 ]]';
$array = $json->decode('[37.7668 , [ 20 ]] ');
is_deeply $array, [37.7668, [20]], 'decode [37.7668 , [ 20 ]] ';
$array = $json->decode('[1e3]');
@@ -150,12 +154,18 @@ is $string, '[true,false]', 'encode [$json->true, $json->false]';
# Encode number
$string = $json->encode([1]);
is $string, '[1]', 'encode [1]';
+$string = $json->encode(["1"]);
+is $string, '["1"]', 'encode ["1"]';
$string = $json->encode(['-122.026020']);
-is $string, '[-122.026020]', 'encode [\'-122.026020\']';
+is $string, '["-122.026020"]', 'encode [\'-122.026020\']';
+$string = $json->encode([-122.026020]);
+is $string, '[-122.02602]', 'encode [-122.026020]';
$string = $json->encode([1, -2]);
is $string, '[1,-2]', 'encode [1, -2]';
$string = $json->encode(['10e12', [2]]);
-is $string, '[10e12,[2]]', 'encode [\'10e12\', [2]]';
+is $string, '["10e12",[2]]', 'encode [\'10e12\', [2]]';
+$string = $json->encode([10e12, [2]]);
+is $string, '[10000000000000,[2]]', 'encode [10e12, [2]]';
$string = $json->encode([37.7668, [20]]);
is $string, '[37.7668,[20]]', 'encode [37.7668, [20]]';
@@ -60,8 +60,8 @@ ok LoaderTest::A->can('new'), 'loaded successfully';
ok LoaderTest::B->can('new'), 'loaded successfully';
ok LoaderTest::C->can('new'), 'loaded successfully';
-# Load unrelated class
-ok $loader->load('LoaderTest'), 'loaded successfully';
+# Class does not exist
+ok $loader->load('LoaderTest'), 'nothing to load';
# Reload
my $file = IO::File->new;
@@ -5,7 +5,7 @@ use warnings;
use utf8;
-use Test::More tests => 951;
+use Test::More tests => 952;
use File::Spec;
use File::Temp;
@@ -277,7 +277,7 @@ is $req->content->asset->slurp, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 chunked request with callback
$req = Mojo::Message::Request->new;
my $buffer = '';
-$req->on_read(sub { $buffer .= pop });
+$req->body(sub { $buffer .= pop });
$req->parse("POST /foo/bar/baz.html?foo=13#23 HTTP/1.1\x0d\x0a");
$req->parse("Content-Type: text/plain\x0d\x0a");
$req->parse("Transfer-Encoding: chunked\x0d\x0a\x0d\x0a");
@@ -2117,7 +2117,8 @@ is $req->method, 'GET', 'right method';
is $req->version, '1.1', 'right version';
is $req->at_least_version('1.0'), 1, 'at least version 1.0';
is $req->at_least_version('1.2'), undef, 'not version 1.2';
-is $req->url, '/perldoc?Mojo::Message::Request', 'right URL';
+is $req->url, '/perldoc?Mojo%3A%3AMessage%3A%3ARequest', 'right URL';
+is $req->url->query->params->[0], 'Mojo::Message::Request', 'right value';
# Body helper
$req = Mojo::Message::Request->new;
@@ -2138,8 +2139,8 @@ is $req->body, 0, 'right content';
$req->body(sub { });
is ref $req->body, 'CODE', 'body is callback';
$req->body('hello!');
-is $req->body, 'hello!', 'right content';
-is $req->on_read, undef, 'no read callback';
+is $req->body, 'hello!', 'right content';
+is $req->content->on_read, undef, 'no read callback';
$req->content(Mojo::Content::MultiPart->new);
$req->body('hi!');
is $req->body, 'hi!', 'right content';
@@ -5,7 +5,7 @@ use warnings;
use utf8;
-use Test::More tests => 42;
+use Test::More tests => 44;
# Now that's a wave of destruction that's easy on the eyes.
use_ok 'Mojo::Parameters';
@@ -59,6 +59,10 @@ is_deeply [$params->param], [qw/q t w/], 'right structure';
$params->append('a', 4, 'a', 5, 'b', 6, 'b', 7);
is_deeply $params->to_hash,
{a => [4, 5], b => [6, 7], q => 1, w => 2, t => 7}, 'right structure';
+$params = Mojo::Parameters->new(foo => undef, bar => 'bar');
+is $params->to_string, 'foo=&bar=bar', 'right format';
+$params = Mojo::Parameters->new(bar => 'bar', foo => undef);
+is $params->to_string, 'bar=bar&foo=', 'right format';
# 0 value
$params = Mojo::Parameters->new(foo => 0);
@@ -105,7 +109,10 @@ is_deeply [$params->param('foo')], [qw/bar baz/], 'right values';
is $params->param('a'), 'b', 'right value';
is_deeply [$params->param('bar')], [qw/bas test/], 'right values';
is_deeply $params->to_hash,
- {foo => ['bar', 'baz'], a => 'b', bar => ['bas', 'test']},
+ { foo => ['bar', 'baz'],
+ a => 'b',
+ bar => ['bas', 'test']
+ },
'right structure';
# Unicode
@@ -9,7 +9,7 @@ use Mojo::JSON;
# We need some more secret sauce. Put the mayonnaise in the sun.
use_ok 'Mojo::Server::PSGI';
-use_ok 'Mojo::Command::Psgi';
+use_ok 'Mojolicious::Command::Psgi';
# Binding
my $psgi = Mojo::Server::PSGI->new;
@@ -38,7 +38,7 @@ is $res->[0], 200, 'right status';
my %headers = @{$res->[1]};
is keys(%headers), 3, 'right number of headers';
ok $headers{Date}, 'right "Date" value';
-is $headers{'Content-Length'}, 41, 'right "Content-Length" value';
+is $headers{'Content-Length'}, 43, 'right "Content-Length" value';
is $headers{'Content-Type'}, 'application/json', 'right "Content-Type" value';
my $params = '';
while (defined(my $chunk = $res->[2]->getline)) { $params .= $chunk }
@@ -70,13 +70,13 @@ $env = {
'psgi.multiprocess' => 1,
'psgi.run_once' => 0
};
-$app = Mojo::Command::Psgi->new->run;
+$app = Mojolicious::Command::Psgi->new->run;
$res = $app->($env);
is $res->[0], 200, 'right status';
%headers = @{$res->[1]};
is keys(%headers), 3, 'right number of headers';
ok $headers{Date}, 'right "Date" value';
-is $headers{'Content-Length'}, 41, 'right "Content-Length" value';
+is $headers{'Content-Length'}, 43, 'right "Content-Length" value';
is $headers{'Content-Type'}, 'application/json', 'right "Content-Type" value';
$params = '';
while (defined(my $chunk = $res->[2]->getline)) { $params .= $chunk }
@@ -5,7 +5,7 @@ use warnings;
use utf8;
-use Test::More tests => 154;
+use Test::More tests => 160;
# I don't want you driving around in a car you built yourself.
# You can sit there complaining, or you can knit me some seat belts.
@@ -270,11 +270,11 @@ is $url->is_ipv4, 1, 'is an IPv4 address';
is $url->is_ipv6, undef, 'not an IPv6 address';
$url = Mojo::URL->new('http://0::127.0.0.1');
is $url->host, '0::127.0.0.1', 'right host';
-is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv4, undef, 'not an IPv4 address';
is $url->is_ipv6, 1, 'is an IPv6 address';
$url = Mojo::URL->new('http://[0::127.0.0.1]');
is $url->host, '[0::127.0.0.1]', 'right host';
-is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv4, undef, 'not an IPv4 address';
is $url->is_ipv6, 1, 'is an IPv6 address';
$url = Mojo::URL->new('http://mojolicio.us:3000');
is $url->host, 'mojolicio.us', 'right host';
@@ -290,9 +290,17 @@ is $url->is_ipv4, 1, 'is an IPv4 address';
is $url->is_ipv6, undef, 'not an IPv6 address';
$url = Mojo::URL->new('http://0::127.0.0.1:3000');
is $url->host, '0::127.0.0.1', 'right host';
-is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv4, undef, 'not an IPv4 address';
is $url->is_ipv6, 1, 'is an IPv6 address';
$url = Mojo::URL->new('http://[0::127.0.0.1]:3000');
is $url->host, '[0::127.0.0.1]', 'right host';
-is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv4, undef, 'not an IPv4 address';
is $url->is_ipv6, 1, 'is an IPv6 address';
+$url = Mojo::URL->new('http://foo.1.1.1.1.de/');
+is $url->host, 'foo.1.1.1.1.de', 'right host';
+is $url->is_ipv4, undef, 'not an IPv4 address';
+is $url->is_ipv6, undef, 'not an IPv4 address';
+$url = Mojo::URL->new('http://1.1.1.1.1.1/');
+is $url->host, '1.1.1.1.1.1', 'right host';
+is $url->is_ipv4, undef, 'not an IPv4 address';
+is $url->is_ipv6, undef, 'not an IPv4 address';
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 194;
@@ -40,7 +40,7 @@ $t->get_ok('/foo/syntaxerror')->status_is(500)
$t->get_ok('/foo/badtemplate')->status_is(404)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/File Not Found/);
+ ->content_like(qr/Not Found/);
# Foo::authenticated (authentication bridge)
$t->get_ok('/auth/authenticated', {'X-Bender' => 'Hi there!'})->status_is(200)
@@ -52,7 +52,7 @@ $t->get_ok('/auth/authenticated', {'X-Bender' => 'Hi there!'})->status_is(200)
$t->get_ok('/auth/authenticated')->status_is(404)
->header_is('X-Bender' => undef)->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/File Not Found/);
+ ->content_like(qr/Not Found/);
# Foo::test
$t->get_ok('/foo/test', {'X-Test' => 'Hi there!'})->status_is(200)
@@ -135,7 +135,7 @@ $t->get_ok('/test6', {'X-Test' => 'Hi there!'})->status_is(200)
$t->get_ok('/', {'X-Test' => 'Hi there!'})->status_is(404)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/File Not Found/);
+ ->content_like(qr/Not Found/);
# Check Last-Modified header for static files
my $path = File::Spec->catdir($FindBin::Bin, 'public_dev', 'hello.txt');
@@ -155,7 +155,7 @@ $t->get_ok('/hello.txt')->status_is(200)
$t->get_ok('/../../mojolicious/secret.txt')->status_is(404)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/File Not Found/);
+ ->content_like(qr/Not Found/);
# Check If-Modified-Since
$t->get_ok('/hello.txt', {'If-Modified-Since' => $mtime})->status_is(304)
@@ -228,7 +228,7 @@ $t->get_ok('/foo/bar')->status_is(200)
$t->get_ok('/baz/does_not_exist')->status_is(404)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/File Not Found/);
+ ->content_like(qr/Not Found/);
$t = Test::Mojo->new(app => 'MojoliciousTest');
@@ -5,8 +5,8 @@ use warnings;
use utf8;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 38;
@@ -0,0 +1,187 @@
+#!/usr/bin/env perl
+
+package Test::Foo;
+
+use strict;
+use warnings;
+
+use base 'Mojolicious::Controller';
+
+sub bar {1}
+sub home {1}
+
+package Test::Controller;
+
+use strict;
+use warnings;
+
+use base 'Mojolicious::Controller';
+
+__PACKAGE__->attr('render_called');
+
+sub render { shift->render_called(1) }
+
+sub reset_state {
+ my $self = shift;
+ $self->render_called(0);
+ my $stash = $self->stash;
+ delete $stash->{$_} for keys %$stash;
+}
+
+# I was all of history's greatest acting robots -- Acting Unit 0.8,
+# Thespomat, David Duchovny!
+package main;
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 67;
+
+use Mojo;
+use Mojo::Transaction::HTTP;
+use Mojolicious::Controller;
+use Mojolicious::Routes;
+
+my $c = Mojolicious::Controller->new;
+
+# Set
+$c->stash(foo => 'bar');
+is $c->stash('foo'), 'bar', 'set and return a stash value';
+
+# Ref value
+my $stash = $c->stash;
+is_deeply $stash, {foo => 'bar'}, 'return a hashref';
+
+# Replace
+$c->stash(foo => 'baz');
+is $c->stash('foo'), 'baz', 'replace and return a stash value';
+
+# Set 0
+$c->stash(zero => 0);
+is $c->stash('zero'), 0, 'set and return 0 value';
+
+# Replace with 0
+$c->stash(foo => 0);
+is $c->stash('foo'), 0, 'replace and return 0 value';
+
+# Use 0 as key
+$c->stash(0 => 'boo');
+is $c->stash('0'), 'boo', 'set and get with 0 as key';
+
+# Delete
+$stash = $c->stash;
+delete $stash->{foo};
+delete $stash->{0};
+delete $stash->{zero};
+is_deeply $stash, {}, 'elements can be deleted';
+$c->stash('foo' => 'zoo');
+delete $c->stash->{foo};
+is_deeply $c->stash, {}, 'elements can be deleted';
+
+# Set via hash
+$c->stash({a => 1, b => 2});
+$stash = $c->stash;
+is_deeply $stash, {a => 1, b => 2}, 'set via hashref';
+
+$c = Test::Controller->new(app => Mojo->new);
+$c->app->log->path(undef);
+$c->app->log->level('fatal');
+my $d = Mojolicious::Routes->new;
+ok $d, 'initialized';
+
+$d->namespace('Test');
+$d->route('/')->to(controller => 'foo', action => 'home');
+$d->route('/foo/(capture)')->to(controller => 'foo', action => 'bar');
+
+# 404 clean stash
+$c->reset_state;
+my $tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/not_found');
+$c->tx($tx);
+is $d->dispatch($c), 1, 'dispatched';
+is_deeply $c->stash, {}, 'empty stash';
+ok !$c->render_called, 'nothing rendered';
+
+# No escaping
+$c->reset_state;
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('POST');
+$tx->req->url->parse('/foo/hello');
+$c->tx($tx);
+$c->stash(test => 23);
+is $d->dispatch($c), undef, 'dispatched';
+is $c->stash->{controller}, 'foo', 'right value';
+is $c->stash->{action}, 'bar', 'right value';
+is $c->stash->{capture}, 'hello', 'right value';
+is $c->stash->{test}, 23, 'right value';
+is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'hello', 'right value';
+is_deeply [$c->param], [qw/action capture controller/], 'right names';
+$c->param(capture => 'bye');
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'bye', 'right value';
+is_deeply [$c->param], [qw/action capture controller/], 'right names';
+$c->param(capture => undef);
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), undef, 'no value';
+is_deeply [$c->param], [qw/action capture controller/], 'right names';
+$c->req->param(foo => 'bar');
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), undef, 'no value';
+is $c->param('foo'), 'bar', 'right value';
+is_deeply [$c->param], [qw/action capture controller foo/], 'right names';
+$c->req->param(bar => 'baz');
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), undef, 'no value';
+is $c->param('foo'), 'bar', 'right value';
+is $c->param('bar'), 'baz', 'right value';
+is_deeply [$c->param], [qw/action bar capture controller foo/], 'right names';
+$c->req->param(action => 'baz');
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), undef, 'no value';
+is $c->param('foo'), 'bar', 'right value';
+is $c->param('bar'), 'baz', 'right value';
+is_deeply [$c->param], [qw/action bar capture controller foo/], 'right names';
+ok $c->render_called, 'rendered';
+
+# Escaping
+$c->reset_state;
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/foo/hello%20there');
+$c->tx($tx);
+is $d->dispatch($c), undef, 'dispatched';
+is $c->stash->{controller}, 'foo', 'right value';
+is $c->stash->{action}, 'bar', 'right value';
+is $c->stash->{capture}, 'hello there', 'right value';
+is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'hello there', 'right value';
+ok $c->render_called, 'rendered';
+
+# Escaping utf8
+$c->reset_state;
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/foo/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82');
+$c->tx($tx);
+is $d->dispatch($c), undef, 'dispatched';
+is $c->stash->{controller}, 'foo', 'right value';
+is $c->stash->{action}, 'bar', 'right value';
+is $c->stash->{capture}, 'привет', 'right value';
+is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'привет', 'right value';
+ok $c->render_called, 'rendered';
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 9;
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 35;
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
+
+use Test::More tests => 6;
+
+# This calls for a party, baby.
+# I'm ordering 100 kegs, 100 hookers and 100 Elvis impersonators that aren't
+# above a little hooking should the occasion arise.
+use Mojolicious::Lite;
+use Test::Mojo;
+
+app->renderer->root(app->home->rel_dir('does_not_exist'));
+
+# GET /dead_template
+get '/dead_template' => '*';
+
+get '/dead_action' => sub { die 'dead action!' };
+
+my $t = Test::Mojo->new;
+
+# GET /dead_template
+$t->get_ok('/dead_template')->status_is(500)
+ ->content_like(qr/1.*die.*dead\ template!/);
+
+# GET /dead_action
+$t->get_ok('/dead_action')->status_is(500)
+ ->content_like(qr/22.*die.*dead\ action!/);
+
+__DATA__
+@@ dead_template.html.ep
+% die 'dead template!';
@@ -5,9 +5,9 @@ use warnings;
use utf8;
-# Disable epoll, kqueue and IPv6
+# Disable epoll and kqueue
BEGIN {
- $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_POLL} = 1;
$ENV{MOJO_MODE} = 'testing';
}
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 24;
@@ -5,8 +5,8 @@ use warnings;
use utf8;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 8;
@@ -5,9 +5,9 @@ use warnings;
use utf8;
-# Disable epoll, kqueue and IPv6
+# Disable epoll and kqueue
BEGIN {
- $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_POLL} = 1;
$ENV{MOJO_MODE} = 'testing';
}
@@ -5,8 +5,8 @@ use warnings;
use utf8;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 664;
@@ -148,11 +148,11 @@ get ':number' => [number => qr/0/] => sub {
# GET /tags
get 'tags/:test' => 'tags';
-# GET /selection
-get 'selection' => '*';
+# PUT /selection
+put 'selection' => '*';
-# GET /inline/epl
-get '/inline/epl' => sub { shift->render(inline => '<%= 1 + 1%>') };
+# DELETE /inline/epl
+del '/inline/epl' => sub { shift->render(inline => '<%= 1 + 1%>') };
# GET /inline/ep
get '/inline/ep' =>
@@ -467,14 +467,14 @@ get '/captures/:foo/:bar' => sub {
app->routes->add_condition(
default => sub {
my ($r, $c, $captures, $num) = @_;
- $captures->{test} = "$num works!";
+ $captures->{test} = $captures->{text} . "$num works!";
return 1 if $c->stash->{default} == $num;
return;
}
);
# GET /default/condition
-get '/default/condition' => (default => 23) => sub {
+get '/default/:text' => (default => 23) => sub {
my $self = shift;
my $default = $self->stash('default');
my $test = $self->stash('test');
@@ -826,20 +826,28 @@ $t->get_ok('/tags/lala?a=b&b=0&c=2&d=3&escaped=1%22+%222')->status_is(200)
<input name="escaped" value="1" "2" />
<input name="a" value="b" />
<input name="a" value="b" />
-<script src="script.js" type="text/javascript" />
-<script type="text/javascript"><![CDATA[
+<script src="script.js" type="text/javascript"></script>
+<script type="text/javascript">//<![CDATA[
+
var a = 'b';
-]]></script>
-<script type="foo"><![CDATA[
+
+//]]></script>
+<script type="foo">//<![CDATA[
+
var a = 'b';
-]]></script>
+
+//]]></script>
<link href="foo.css" media="screen" rel="stylesheet" type="text/css" />
-<style type="text/css"><![CDATA[
+<style type="text/css">/*<![CDATA[*/
+
body {color: #000}
-]]></style>
-<style type="foo"><![CDATA[
+
+/*]]>*/</style>
+<style type="foo">/*<![CDATA[*/
+
body {color: #000}
-]]></style>
+
+/*]]>*/</style>
EOF
# GET /tags (alternative)
@@ -876,24 +884,32 @@ $t->get_ok('/tags/lala?c=b&d=3&e=4&f=5')->status_is(200)->content_is(<<EOF);
<input name="escaped" />
<input name="a" />
<input name="a" value="c" />
-<script src="script.js" type="text/javascript" />
-<script type="text/javascript"><![CDATA[
+<script src="script.js" type="text/javascript"></script>
+<script type="text/javascript">//<![CDATA[
+
var a = 'b';
-]]></script>
-<script type="foo"><![CDATA[
+
+//]]></script>
+<script type="foo">//<![CDATA[
+
var a = 'b';
-]]></script>
+
+//]]></script>
<link href="foo.css" media="screen" rel="stylesheet" type="text/css" />
-<style type="text/css"><![CDATA[
+<style type="text/css">/*<![CDATA[*/
+
body {color: #000}
-]]></style>
-<style type="foo"><![CDATA[
+
+/*]]>*/</style>
+<style type="foo">/*<![CDATA[*/
+
body {color: #000}
-]]></style>
+
+/*]]>*/</style>
EOF
-# GET /selection (empty)
-$t->get_ok('/selection')->status_is(200)
+# PUT /selection (empty)
+$t->put_ok('/selection')->status_is(200)
->content_is("<form action=\"/selection\">\n "
. '<select name="a">'
. '<option value="b">b</option>'
@@ -914,8 +930,8 @@ $t->get_ok('/selection')->status_is(200)
. '</form>'
. "\n");
-# GET /selection (values)
-$t->get_ok('/selection?a=e&foo=bar')->status_is(200)
+# PUT /selection (values)
+$t->put_ok('/selection?a=e&foo=bar')->status_is(200)
->content_is("<form action=\"/selection\">\n "
. '<select name="a">'
. '<option value="b">b</option>'
@@ -936,8 +952,8 @@ $t->get_ok('/selection?a=e&foo=bar')->status_is(200)
. '</form>'
. "\n");
-# GET /selection (multiple values)
-$t->get_ok('/selection?foo=bar&a=e&foo=baz')->status_is(200)
+# PUT /selection (multiple values)
+$t->put_ok('/selection?foo=bar&a=e&foo=baz')->status_is(200)
->content_is("<form action=\"/selection\">\n "
. '<select name="a">'
. '<option value="b">b</option>'
@@ -958,8 +974,8 @@ $t->get_ok('/selection?foo=bar&a=e&foo=baz')->status_is(200)
. '</form>'
. "\n");
-# GET /inline/epl
-$t->get_ok('/inline/epl')->status_is(200)->content_is("2\n");
+# DELETE /inline/epl
+$t->delete_ok('/inline/epl')->status_is(200)->content_is("2\n");
# GET /inline/ep
$t->get_ok('/inline/ep?foo=bar')->status_is(200)->content_is("barworks!\n");
@@ -996,7 +1012,7 @@ $t->get_ok('/foo_wildcard/')->status_is(404);
# GET /with/header/condition
$t->get_ok('/with/header/condition', {'X-Secret-Header' => 'bar'})
- ->status_is(200)->content_like(qr/^Test ok/);
+ ->status_is(200)->content_like(qr/^Test ok<base href="http:\/\/localhost/);
# GET /with/header/condition (not found)
$t->get_ok('/with/header/condition')->status_is(404)->content_like(qr/Oops!/);
@@ -1209,8 +1225,8 @@ $t->post_form_ok('/utf8', 'UTF-8' => {name => 'Вячеслав'})
->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->header_is('Content-Length' => 40)->content_type_is('text/html')
- ->content_is(b("Вячеслав Тихановский\n")->encode('UTF-8')
- ->to_string);
+ ->content_is(
+ b("Вячеслав Тихановский\n")->encode->to_string);
# POST /utf8 (multipart/form-data)
$t->post_form_ok(
@@ -1453,7 +1469,7 @@ $t->get_ok('/hello3.txt', {'Range' => 'bytes=0-0'})->status_is(206)
$t->get_ok('/default/condition')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is('works 23 23 works!');
+ ->content_is('works 23 condition23 works!');
# GET /redirect/condition/0
$t->get_ok('/redirect/condition/0')->status_is(200)
@@ -1658,8 +1674,8 @@ text!
@@ static2.txt (base64)
dGVzdCAxMjMKbGFsYWxh
-@@ with_header_condition.html.epl
-Test ok
+@@ with_header_condition.html.ep
+Test ok<%= base_tag %>
@@ template_inheritance.html.ep
% layout 'template_inheritance';
@@ -3,10 +3,10 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
-use Test::More tests => 49;
+use Test::More tests => 69;
# I was God once.
# Yes, I saw. You were doing well until everyone died.
@@ -14,10 +14,11 @@ use Mojolicious::Lite;
use Test::Mojo;
# GET /shortpoll
-my $shortpoll;
+my $shortpoll = 0;
get '/shortpoll' => sub {
my $self = shift;
- $self->on_finish(sub { $shortpoll = 'finished!' });
+ $self->res->headers->connection('close');
+ $self->on_finish(sub { $shortpoll++ });
$self->res->code(200);
$self->res->headers->content_type('text/plain');
$self->write_chunk('this was short.');
@@ -70,13 +71,13 @@ get '/longpoll/nested' => sub {
my $longpoll_plain;
get '/longpoll/plain' => sub {
my $self = shift;
- $self->on_finish(sub { $longpoll_plain = 'finished!' });
$self->res->code(200);
$self->res->headers->content_type('text/plain');
$self->res->headers->content_length(25);
$self->write('hi ');
$self->client->ioloop->timer(
'0.5' => sub {
+ $self->on_finish(sub { $longpoll_plain = 'finished!' });
$self->write('there plain,', sub { shift->write(' whats up?') });
}
);
@@ -126,6 +127,36 @@ get '/longpoll/plain/delayed' => sub {
);
};
+# GET /longpoll/static/delayed
+my $longpoll_static_delayed;
+get '/longpoll/static/delayed' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $longpoll_static_delayed = 'finished!' });
+ $self->client->ioloop->timer(
+ '0.5' => sub { $self->render_static('hello.txt') });
+};
+
+# GET /too_long
+my $too_long;
+get '/too_long' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $too_long = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->res->headers->content_length(12);
+ $self->write('how');
+ $self->client->ioloop->timer(
+ '5' => sub {
+ $self->write(
+ sub {
+ my $self = shift;
+ $self->write('dy plain!');
+ }
+ );
+ }
+ );
+};
+
my $t = Test::Mojo->new;
# GET /shortpoll
@@ -133,13 +164,17 @@ $t->get_ok('/shortpoll')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_type_is('text/plain')->content_is('this was short.');
-is $shortpoll, 'finished!', 'finished';
+is $t->tx->kept_alive, undef, 'connection was not kept alive';
+is $t->tx->keep_alive, 0, 'connection will not be kept alive';
+is $shortpoll, 1, 'finished';
# GET /shortpoll/plain
$t->get_ok('/shortpoll/plain')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_type_is('text/plain')->content_is('this was short and plain.');
+is $t->tx->kept_alive, undef, 'connection was not kept alive';
+is $t->tx->keep_alive, 1, 'connection will be kept alive';
is $shortpoll_plain, 'finished!', 'finished';
# GET /longpoll
@@ -147,8 +182,44 @@ $t->get_ok('/longpoll')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_type_is('text/plain')->content_is('hi there, whats up?');
+is $t->tx->kept_alive, 1, 'connection was kept alive';
+is $t->tx->keep_alive, 1, 'connection will be kept alive';
is $longpoll, 'finished!', 'finished';
+# GET /longpoll (interrupted)
+$longpoll = undef;
+my $port = $t->client->test_server;
+$t->client->ioloop->connect(
+ address => 'localhost',
+ port => $port,
+ on_connect => sub {
+ my ($self, $id) = @_;
+ $self->write($id => "GET /longpoll HTTP/1.1\x0d\x0a\x0d\x0a");
+ },
+ on_read => sub {
+ my ($self, $id, $chunk) = @_;
+ $self->drop($id);
+ $self->timer('0.5', sub { shift->stop });
+ }
+);
+$t->client->ioloop->start;
+is $longpoll, 'finished!', 'finished';
+
+# GET /longpoll (also interrupted)
+my $tx = $t->client->build_tx(GET => '/longpoll');
+my $buffer = '';
+$tx->res->body(
+ sub {
+ my ($self, $chunk) = @_;
+ $buffer .= $chunk;
+ $self->error('Interrupted!');
+ }
+);
+$t->client->process($tx);
+is $tx->res->code, 200, 'right status';
+is $tx->res->error, 'Interrupted!', 'right error';
+is $buffer, 'hi ', 'right content';
+
# GET /longpoll/nested
$t->get_ok('/longpoll/nested')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
@@ -176,3 +247,25 @@ $t->get_ok('/longpoll/plain/delayed')->status_is(200)
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_type_is('text/plain')->content_is('howdy plain!');
is $longpoll_plain_delayed, 'finished!', 'finished';
+
+# GET /longpoll/static/delayed
+$t->get_ok('/longpoll/static/delayed')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')
+ ->content_is('Hello Mojo from a static file!');
+is $longpoll_static_delayed, 'finished!', 'finished';
+
+# GET /too_long (timeout)
+$tx = $t->client->keep_alive_timeout(1)->build_tx(GET => '/too_long');
+$buffer = '';
+$tx->res->body(
+ sub {
+ my ($self, $chunk) = @_;
+ $buffer .= $chunk;
+ }
+);
+$t->client->process($tx);
+is $tx->res->code, 200, 'right status';
+is $tx->error, 'Interrupted, maybe a timeout?', 'right error';
+is $buffer, 'how', 'right content';
@@ -0,0 +1,101 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 38;
+
+# People said I was dumb, but I proved them.
+use_ok 'Mojolicious::Routes::Pattern';
+
+# Normal pattern with text, symbols and a default value
+my $pattern = Mojolicious::Routes::Pattern->new('/test/(controller)/:action');
+$pattern->defaults({action => 'index'});
+my $result = $pattern->match('/test/foo/bar');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar', 'right value';
+$result = $pattern->match('/test/foo');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'index', 'right value';
+$result = $pattern->match('/test/foo/');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'index', 'right value';
+$result = $pattern->match('/test/');
+is $result, undef, 'no result';
+is $pattern->render({controller => 'foo'}), '/test/foo', 'right result';
+
+# Root
+$pattern = Mojolicious::Routes::Pattern->new('/');
+$pattern->defaults({action => 'index'});
+$result = $pattern->match('/test/foo/bar');
+is $result, undef, 'no result';
+$result = $pattern->match('/');
+is $result->{action}, 'index', 'right value';
+is $pattern->render, '/', 'right result';
+
+# Regex in pattern
+$pattern =
+ Mojolicious::Routes::Pattern->new('/test/(controller)/:action/(id)',
+ id => '\d+');
+$pattern->defaults({action => 'index', id => 1});
+$result = $pattern->match('/test/foo/bar/203');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar', 'right value';
+is $result->{id}, 203, 'right value';
+$result = $pattern->match('/test/foo/bar/baz');
+is_deeply $result, undef, 'no result';
+is $pattern->render({controller => 'zzz', action => 'index', id => 13}),
+ '/test/zzz/index/13', 'right result';
+is $pattern->render({controller => 'zzz'}), '/test/zzz', 'right result';
+
+# Quoted symbol
+$pattern = Mojolicious::Routes::Pattern->new('/(:controller)test/(action)');
+$pattern->defaults({action => 'index'});
+$result = $pattern->match('/footest/bar');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar', 'right value';
+is $pattern->render({controller => 'zzz', action => 'lala'}), '/zzztest/lala',
+ 'right result';
+$result = $pattern->match('/test/lala');
+is $result, undef, 'no result';
+
+# Format
+$pattern = Mojolicious::Routes::Pattern->new('/(controller)test/(action)');
+is $pattern->format, undef, 'no value';
+$pattern =
+ Mojolicious::Routes::Pattern->new('/(:controller)test/:action.html');
+is $pattern->format, 'html', 'right value';
+$pattern = Mojolicious::Routes::Pattern->new('/index.cgi');
+is $pattern->format, 'cgi', 'right value';
+
+# Relaxed
+$pattern = Mojolicious::Routes::Pattern->new('/test/(.controller)/:action');
+$result = $pattern->match('/test/foo.bar/baz');
+is $result->{controller}, 'foo.bar', 'right value';
+is $result->{action}, 'baz', 'right value';
+is $pattern->render({controller => 'foo.bar', action => 'baz'}),
+ '/test/foo.bar/baz', 'right result';
+$pattern = Mojolicious::Routes::Pattern->new('/test/(.groovy)');
+$result = $pattern->match('/test/foo.bar');
+is $pattern->format, undef, 'no value';
+is $result->{groovy}, 'foo.bar', 'right value';
+is $result->{format}, undef, 'no value';
+is $pattern->render({groovy => 'foo.bar'}), '/test/foo.bar', 'right result';
+
+# Wildcard
+$pattern = Mojolicious::Routes::Pattern->new('/test/(:controller)/(*action)');
+$result = $pattern->match('/test/foo/bar.baz/yada');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar.baz/yada', 'right value';
+is $pattern->render({controller => 'foo', action => 'bar.baz/yada'}),
+ '/test/foo/bar.baz/yada', 'right result';
+
+# Render false value
+$pattern = Mojolicious::Routes::Pattern->new('/:id');
+is $pattern->render({id => 0}), '/0', 'right result';
+
+# Regex in path
+$pattern = Mojolicious::Routes::Pattern->new('/:test');
+$result = $pattern->match('/test(test)(\Qtest\E)(');
+is $result->{test}, 'test(test)(\Qtest\E)(', 'right value';
+is $pattern->render({test => '23'}), '/23', 'right result';
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More;
plan skip_all => 'Perl 5.10 required for this test!'
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 26;
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use Mojolicious;
+use Mojolicious::Controller;
+use Mojolicious::Renderer;
+
+# Actually, she wasn't really my girlfriend,
+# she just lived nextdoor and never closed her curtains.
+my $c = Mojolicious::Controller->new(app => Mojolicious->new);
+$c->app->log->path(undef);
+$c->app->log->level('fatal');
+my $r = Mojolicious::Renderer->new(default_format => 'debug');
+$r->add_handler(
+ debug => sub {
+ my ($self, $c, $output) = @_;
+ $$output .= 'Hello Mojo!';
+ }
+);
+$c->stash->{format} = 'something';
+
+# Normal rendering
+$c->stash->{template} = 'something';
+$c->stash->{handler} = 'debug';
+is_deeply [$r->render($c)], ['Hello Mojo!', 'text/plain'], 'normal rendering';
+
+# Normal rendering with layout
+$c->stash->{template} = 'something';
+$c->stash->{layout} = 'something';
+$c->stash->{handler} = 'debug';
+is_deeply [$r->render($c)], ['Hello Mojo!Hello Mojo!', 'text/plain'],
+ 'normal rendering with layout';
+is delete $c->stash->{layout}, 'something';
+
+# Rendering a path with dots
+$c->stash->{template} = 'some.path.with.dots/template';
+$c->stash->{handler} = 'debug';
+is_deeply [$r->render($c)], ['Hello Mojo!', 'text/plain'],
+ 'rendering a path with dots';
+
+# Unrecognized handler
+$c->stash->{handler} = 'not_defined';
+is $r->render($c), undef, 'return undef for unrecognized handler';
@@ -0,0 +1,515 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 205;
+
+use Mojo::Transaction::HTTP;
+
+# They're not very heavy, but you don't hear me not complaining.
+use_ok 'Mojolicious::Routes';
+use_ok 'Mojolicious::Routes::Match';
+
+# Routes
+my $r = Mojolicious::Routes->new;
+
+# /clean
+$r->route('/clean')->to(clean => 1);
+
+# /clean/too
+$r->route('/clean/too')->to(something => 1);
+
+# /*/test
+my $test = $r->route('/:controller/test')->to(action => 'test');
+
+# /*/test/edit
+$test->route('/edit')->to(action => 'edit')->name('test_edit');
+
+# /*/test/delete/*
+$test->route('/delete/(id)', id => qr/\d+/)->to(action => 'delete', id => 23);
+
+# /test2
+my $test2 = $r->bridge('/test2')->to(controller => 'test2');
+
+# /test2 (inline)
+my $test4 = $test2->bridge->to(controller => 'index');
+
+# /test2/foo
+$test4->route('/foo')->to(controller => 'baz');
+
+# /test2/bar
+$test4->route('/bar')->to(controller => 'lalala');
+
+# /test2/baz
+$test2->route('/baz')->to('just#works');
+
+# /test3
+my $test3 = $r->waypoint('/test3')->to(controller => 's', action => 'l');
+
+# /test3/edit
+$test3->route('/edit')->to(action => 'edit');
+
+# /
+$r->route('/')->to(controller => 'hello', action => 'world');
+
+# /wildcards/1/*
+$r->route('/wildcards/1/(*wildcard)', wildcard => qr/(.*)/)
+ ->to(controller => 'wild', action => 'card');
+
+# /wildcards/2/*
+$r->route('/wildcards/2/(*wildcard)')
+ ->to(controller => 'card', action => 'wild');
+
+# /wildcards/3/*/foo
+$r->route('/wildcards/3/(*wildcard)/foo')
+ ->to(controller => 'very', action => 'dangerous');
+
+# /format
+# /format.html
+$r->route('/format')
+ ->to(controller => 'hello', action => 'you', format => 'html');
+
+# /format2.html
+$r->route('/format2.html')->to(controller => 'you', action => 'hello');
+
+# /format2.json
+$r->route('/format2.json')->to(controller => 'you', action => 'hello_json');
+
+# /format3/*.html
+$r->route('/format3/:foo.html')->to(controller => 'me', action => 'bye');
+
+# /format3/*.json
+$r->route('/format3/:foo.json')->to(controller => 'me', action => 'bye_json');
+
+# /articles
+# /articles.html
+# /articles/1
+# /articles/1.html
+# /articles/1/edit
+# /articles/1/delete
+my $articles = $r->waypoint('/articles')->to(
+ controller => 'articles',
+ action => 'index',
+ format => 'html'
+);
+my $wp = $articles->waypoint('/:id')->to(
+ controller => 'articles',
+ action => 'load',
+ format => 'html'
+);
+my $bridge = $wp->bridge->to(
+ controller => 'articles',
+ action => 'load',
+ format => 'html'
+);
+$bridge->route('/edit')->to(controller => 'articles', action => 'edit');
+$bridge->route('/delete')->to(
+ controller => 'articles',
+ action => 'delete',
+ format => undef
+)->name('articles_delete');
+
+# GET /method/get
+$r->route('/method/get')->via('GET')
+ ->to(controller => 'method', action => 'get');
+
+# POST /method/post
+$r->route('/method/post')->via('post')
+ ->to(controller => 'method', action => 'post');
+
+# POST|GET /method/post_get
+$r->route('/method/post_get')->via(qw/POST get/)
+ ->to(controller => 'method', action => 'post_get');
+
+# /simple/form
+$r->route('/simple/form')->to('test-test#test');
+
+# /edge/gift
+my $edge = $r->route('/edge');
+my $auth = $edge->bridge('/auth')->to('auth#check');
+$auth->route('/about/')->to('pref#about');
+$auth->bridge->to('album#allow')->route('/album/create/')->to('album#create');
+$auth->route('/gift/')->to('gift#index')->name('gift');
+
+# Make sure stash stays clean
+my $tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/clean');
+my $m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{clean}, 1, 'right value';
+is $m->stack->[0]->{something}, undef, 'no value';
+is $m->url_for, '/clean', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/clean/too');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{clean}, undef, 'no value';
+is $m->stack->[0]->{something}, 1, 'right value';
+is $m->url_for, '/clean/too', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Real world example using most features at once
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles.html');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'articles', 'right value';
+is $m->stack->[0]->{action}, 'index', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/articles', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles/1.html');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'articles', 'right value';
+is $m->stack->[0]->{action}, 'load', 'right value';
+is $m->stack->[0]->{id}, '1', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for(format => 'html'), '/articles/1.html', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles/1/edit');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[1]->{controller}, 'articles', 'right value';
+is $m->stack->[1]->{action}, 'edit', 'right value';
+is $m->stack->[1]->{format}, 'html', 'right value';
+is $m->url_for, '/articles/1/edit', 'right URL';
+is $m->url_for(format => 'html'), '/articles/1/edit.html', 'right URL';
+is $m->url_for('articles_delete', format => undef), '/articles/delete',
+ 'right URL';
+is $m->url_for('articles_delete'), '/articles/delete', 'right URL';
+is $m->url_for('articles_delete', id => 12), '/articles/12/delete',
+ 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles/1/delete');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[1]->{controller}, 'articles', 'right value';
+is $m->stack->[1]->{action}, 'delete', 'right value';
+is $m->stack->[1]->{format}, undef, 'no value';
+is $m->url_for, '/articles/1/delete', 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
+
+# Root
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'hello', 'right value';
+is $m->captures->{action}, 'world', 'right value';
+is $m->stack->[0]->{controller}, 'hello', 'right value';
+is $m->stack->[0]->{action}, 'world', 'right value';
+is $m->url_for, '/', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Path and captures
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/foo/test/edit');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'foo', 'right value';
+is $m->captures->{action}, 'edit', 'right value';
+is $m->stack->[0]->{controller}, 'foo', 'right value';
+is $m->stack->[0]->{action}, 'edit', 'right value';
+is $m->url_for, '/foo/test/edit', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Optional captures in sub route with requirement
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/bar/test/delete/22');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'bar', 'right value';
+is $m->captures->{action}, 'delete', 'right value';
+is $m->captures->{id}, 22, 'right value';
+is $m->stack->[0]->{controller}, 'bar', 'right value';
+is $m->stack->[0]->{action}, 'delete', 'right value';
+is $m->stack->[0]->{id}, 22, 'right value';
+is $m->url_for, '/bar/test/delete/22', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Defaults in sub route
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/bar/test/delete');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'bar', 'right value';
+is $m->captures->{action}, 'delete', 'right value';
+is $m->captures->{id}, 23, 'right value';
+is $m->stack->[0]->{controller}, 'bar', 'right value';
+is $m->stack->[0]->{action}, 'delete', 'right value';
+is $m->stack->[0]->{id}, 23, 'right value';
+is $m->url_for, '/bar/test/delete', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Chained routes
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test2/foo');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test2', 'right value';
+is $m->stack->[1]->{controller}, 'index', 'right value';
+is $m->stack->[2]->{controller}, 'baz', 'right value';
+is $m->captures->{controller}, 'baz', 'right value';
+is $m->url_for, '/test2/foo', 'right URL';
+is @{$m->stack}, 3, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test2/bar');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test2', 'right value';
+is $m->stack->[1]->{controller}, 'index', 'right value';
+is $m->stack->[2]->{controller}, 'lalala', 'right value';
+is $m->captures->{controller}, 'lalala', 'right value';
+is $m->url_for, '/test2/bar', 'right URL';
+is @{$m->stack}, 3, 'right number of elements';
+$tx->req->url->parse('/test2/baz');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test2', 'right value';
+is $m->stack->[1]->{controller}, 'just', 'right value';
+is $m->stack->[1]->{action}, 'works', 'right value';
+is $m->stack->[2], undef, 'no value';
+is $m->captures->{controller}, 'just', 'right value';
+is $m->url_for, '/test2/baz', 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
+
+# Waypoints
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 's', 'right value';
+is $m->stack->[0]->{action}, 'l', 'right value';
+is $m->url_for, '/test3', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3/');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 's', 'right value';
+is $m->stack->[0]->{action}, 'l', 'right value';
+is $m->url_for, '/test3', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3/edit');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 's', 'right value';
+is $m->stack->[0]->{action}, 'edit', 'right value';
+is $m->url_for, '/test3/edit', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Named url_for
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->url_for, '/test3', 'right URL';
+is $m->url_for('test_edit', controller => 'foo'), '/foo/test/edit',
+ 'right URL';
+is $m->url_for('test_edit', {controller => 'foo'}), '/foo/test/edit',
+ 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Wildcards
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/1/hello/there');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'wild', 'right value';
+is $m->stack->[0]->{action}, 'card', 'right value';
+is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
+is $m->url_for, '/wildcards/1/hello/there', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/2/hello/there');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'card', 'right value';
+is $m->stack->[0]->{action}, 'wild', 'right value';
+is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
+is $m->url_for, '/wildcards/2/hello/there', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/3/hello/there/foo');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'very', 'right value';
+is $m->stack->[0]->{action}, 'dangerous', 'right value';
+is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
+is $m->url_for, '/wildcards/3/hello/there/foo', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Escaped
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/1/http://www.google.com');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'wild', 'right value';
+is $m->stack->[0]->{action}, 'card', 'right value';
+is $m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value';
+is $m->url_for, '/wildcards/1/http://www.google.com', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/1/http%3A%2F%2Fwww.google.com');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'wild', 'right value';
+is $m->stack->[0]->{action}, 'card', 'right value';
+is $m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value';
+is $m->url_for, '/wildcards/1/http://www.google.com', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Format
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'hello', 'right value';
+is $m->stack->[0]->{action}, 'you', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/format', 'right URL';
+is $m->url_for(format => undef), '/format', 'right URL';
+is $m->url_for(format => 'html'), '/format.html', 'right URL';
+is $m->url_for(format => 'txt'), '/format.txt', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format.html');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'hello', 'right value';
+is $m->stack->[0]->{action}, 'you', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/format', 'right URL';
+is $m->url_for(format => undef), '/format', 'right URL';
+is $m->url_for(format => 'html'), '/format.html', 'right URL';
+is $m->url_for(format => 'txt'), '/format.txt', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format2.html');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'you', 'right value';
+is $m->stack->[0]->{action}, 'hello', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/format2.html', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format2.json');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'you', 'right value';
+is $m->stack->[0]->{action}, 'hello_json', 'right value';
+is $m->stack->[0]->{format}, 'json', 'right value';
+is $m->url_for, '/format2.json', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format3/baz.html');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'me', 'right value';
+is $m->stack->[0]->{action}, 'bye', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->stack->[0]->{foo}, 'baz', 'right value';
+is $m->url_for, '/format3/baz.html', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format3/baz.json');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'me', 'right value';
+is $m->stack->[0]->{action}, 'bye_json', 'right value';
+is $m->stack->[0]->{format}, 'json', 'right value';
+is $m->stack->[0]->{foo}, 'baz', 'right value';
+is $m->url_for, '/format3/baz.json', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Request methods
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/method/get.html');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'get', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/method/get', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('POST');
+$tx->req->url->parse('/method/post');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'post', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/method/post', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/method/post_get');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'post_get', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/method/post_get', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('POST');
+$tx->req->url->parse('/method/post_get');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'post_get', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/method/post_get', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('DELETE');
+$tx->req->url->parse('/method/post_get');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, undef, 'no value';
+is $m->stack->[0]->{action}, undef, 'no value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '', 'no URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Not found
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/not_found');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->url_for('test_edit', controller => 'foo'), '/foo/test/edit',
+ 'right URL';
+is @{$m->stack}, 0, 'no elements';
+
+# Simplified form
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/simple/form');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test-test', 'right value';
+is $m->stack->[0]->{action}, 'test', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/simple/form', 'right URL';
+is $m->url_for('current'), '/simple/form', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Special edge case with nested bridges
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/edge/auth/gift');
+$m = Mojolicious::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'auth', 'right value';
+is $m->stack->[0]->{action}, 'check', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->stack->[1]->{controller}, 'gift', 'right value';
+is $m->stack->[1]->{action}, 'index', 'right value';
+is $m->stack->[1]->{format}, undef, 'no value';
+is $m->stack->[2], undef, 'no value';
+is $m->url_for, '/edge/auth/gift', 'right URL';
+is $m->url_for('gift'), '/edge/auth/gift', 'right URL';
+is $m->url_for('current'), '/edge/auth/gift', 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More;
plan skip_all => 'Perl 5.10 required for this test!'
@@ -5,8 +5,8 @@ use warnings;
use utf8;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More;
plan skip_all => 'Windows is too fragile for this test!' if $^O eq 'MSWin32';
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 29;
@@ -155,17 +155,14 @@ w '/' => sub {
like $result, qr/test1test2ws\:\/\/localhost\:\d+\//, 'right result';
# WebSocket /socket (using an already prepared socket)
-my $peer = $client->test_server;
-my $local = $client->ioloop->generate_port;
+my $port = $client->test_server;
$result = undef;
-my $tx = $client->build_websocket_tx('ws://lalala/socket');
-my $socket = IO::Socket::INET->new(
- PeerAddr => 'localhost',
- PeerPort => $peer,
- LocalPort => $local
-);
+my $tx = $client->build_websocket_tx('ws://lalala/socket');
+my $socket =
+ IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
+$socket->blocking(0);
$tx->connection($socket);
-my $port;
+my $local;
$client->start(
$tx => sub {
my $self = shift;
@@ -176,11 +173,11 @@ $client->start(
$self->finish;
}
);
- $port = $self->ioloop->local_info($self->tx->connection)->{port};
+ $local = $self->ioloop->local_info($self->tx->connection)->{port};
}
);
is $result, 'lalala', 'right result';
-is $port, $local, 'right local port';
+ok $local, 'local port';
# WebSocket /early_start (server directly sends a message)
my $flag2;
@@ -3,8 +3,8 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More tests => 9;
@@ -49,7 +49,7 @@ my $client = Mojo::Client->new;
my $loop = $client->ioloop;
my $server = Mojo::Server::Daemon->new(app => app, ioloop => $loop);
my $port = Mojo::IOLoop->new->generate_port;
-$server->listen("http://*:$port");
+$server->listen(["http://*:$port"]);
$server->prepare_ioloop;
# Connect proxy server for testing
@@ -3,12 +3,12 @@
use strict;
use warnings;
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+# Disable epoll and kqueue
+BEGIN { $ENV{MOJO_POLL} = 1 }
use Test::More;
use Mojo::IOLoop;
-plan skip_all => 'IO::Socket::SSL 1.33 required for this test!'
+plan skip_all => 'IO::Socket::SSL 1.34 required for this test!'
unless Mojo::IOLoop::TLS;
plan tests => 16;
@@ -55,7 +55,7 @@ my $client = Mojo::Client->new;
my $loop = $client->ioloop;
my $server = Mojo::Server::Daemon->new(app => app, ioloop => $loop);
my $port = Mojo::IOLoop->new->generate_port;
-$server->listen("https://*:$port");
+$server->listen(["https://*:$port"]);
$server->prepare_ioloop;
# Connect proxy server for testing
@@ -1,156 +0,0 @@
-#!/usr/bin/env perl
-
-package Test::Foo;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Dispatcher::Routes::Controller';
-
-sub bar {1}
-sub home {1}
-
-package Test::Controller;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Dispatcher::Routes::Controller';
-
-__PACKAGE__->attr('render_called');
-
-sub render { shift->render_called(1) }
-
-sub reset_state {
- my $self = shift;
- $self->render_called(0);
- my $stash = $self->stash;
- delete $stash->{$_} for keys %$stash;
-}
-
-# I was all of history's greatest acting robots -- Acting Unit 0.8,
-# Thespomat, David Duchovny!
-package main;
-
-use strict;
-use warnings;
-
-use utf8;
-
-use Test::More tests => 41;
-
-use Mojo;
-use Mojo::Transaction::HTTP;
-use MojoX::Dispatcher::Routes;
-use MojoX::Dispatcher::Routes::Controller;
-
-my $c = MojoX::Dispatcher::Routes::Controller->new;
-
-# Set
-$c->stash(foo => 'bar');
-is $c->stash('foo'), 'bar', 'set and return a stash value';
-
-# Ref value
-my $stash = $c->stash;
-is_deeply $stash, {foo => 'bar'}, 'return a hashref';
-
-# Replace
-$c->stash(foo => 'baz');
-is $c->stash('foo'), 'baz', 'replace and return a stash value';
-
-# Set 0
-$c->stash(zero => 0);
-is $c->stash('zero'), 0, 'set and return 0 value';
-
-# Replace with 0
-$c->stash(foo => 0);
-is $c->stash('foo'), 0, 'replace and return 0 value';
-
-# Use 0 as key
-$c->stash(0 => 'boo');
-is $c->stash('0'), 'boo', 'set and get with 0 as key';
-
-# Delete
-$stash = $c->stash;
-delete $stash->{foo};
-delete $stash->{0};
-delete $stash->{zero};
-is_deeply $stash, {}, 'elements can be deleted';
-$c->stash('foo' => 'zoo');
-delete $c->stash->{foo};
-is_deeply $c->stash, {}, 'elements can be deleted';
-
-# Set via hash
-$c->stash({a => 1, b => 2});
-$stash = $c->stash;
-is_deeply $stash, {a => 1, b => 2}, 'set via hashref';
-
-$c = Test::Controller->new(app => Mojo->new);
-$c->app->log->path(undef);
-$c->app->log->level('fatal');
-my $d = MojoX::Dispatcher::Routes->new;
-ok $d, 'initialized';
-
-$d->namespace('Test');
-$d->route('/')->to(controller => 'foo', action => 'home');
-$d->route('/foo/(capture)')->to(controller => 'foo', action => 'bar');
-
-# 404 clean stash
-$c->reset_state;
-my $tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/not_found');
-$c->tx($tx);
-is $d->dispatch($c), 1, 'dispatched';
-is_deeply $c->stash, {}, 'empty stash';
-ok !$c->render_called, 'nothing rendered';
-
-# No escaping
-$c->reset_state;
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('POST');
-$tx->req->url->parse('/foo/hello');
-$c->tx($tx);
-$c->stash(test => 23);
-is $d->dispatch($c), undef, 'dispatched';
-is $c->stash->{controller}, 'foo', 'right value';
-is $c->stash->{action}, 'bar', 'right value';
-is $c->stash->{capture}, 'hello', 'right value';
-is $c->stash->{test}, 23, 'right value';
-is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
-is $c->param('controller'), 'foo', 'right value';
-is $c->param('action'), 'bar', 'right value';
-is $c->param('capture'), 'hello', 'right value';
-ok $c->render_called, 'rendered';
-
-# Escaping
-$c->reset_state;
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/foo/hello%20there');
-$c->tx($tx);
-is $d->dispatch($c), undef, 'dispatched';
-is $c->stash->{controller}, 'foo', 'right value';
-is $c->stash->{action}, 'bar', 'right value';
-is $c->stash->{capture}, 'hello there', 'right value';
-is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
-is $c->param('controller'), 'foo', 'right value';
-is $c->param('action'), 'bar', 'right value';
-is $c->param('capture'), 'hello there', 'right value';
-ok $c->render_called, 'rendered';
-
-# Escaping utf8
-$c->reset_state;
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/foo/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82');
-$c->tx($tx);
-is $d->dispatch($c), undef, 'dispatched';
-is $c->stash->{controller}, 'foo', 'right value';
-is $c->stash->{action}, 'bar', 'right value';
-is $c->stash->{capture}, 'привет', 'right value';
-is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
-is $c->param('controller'), 'foo', 'right value';
-is $c->param('action'), 'bar', 'right value';
-is $c->param('capture'), 'привет', 'right value';
-ok $c->render_called, 'rendered';
@@ -1,99 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 38;
-
-# People said I was dumb, but I proved them.
-use_ok 'MojoX::Routes::Pattern';
-
-# Normal pattern with text, symbols and a default value
-my $pattern = MojoX::Routes::Pattern->new('/test/(controller)/:action');
-$pattern->defaults({action => 'index'});
-my $result = $pattern->match('/test/foo/bar');
-is $result->{controller}, 'foo', 'right value';
-is $result->{action}, 'bar', 'right value';
-$result = $pattern->match('/test/foo');
-is $result->{controller}, 'foo', 'right value';
-is $result->{action}, 'index', 'right value';
-$result = $pattern->match('/test/foo/');
-is $result->{controller}, 'foo', 'right value';
-is $result->{action}, 'index', 'right value';
-$result = $pattern->match('/test/');
-is $result, undef, 'no result';
-is $pattern->render({controller => 'foo'}), '/test/foo', 'right result';
-
-# Root
-$pattern = MojoX::Routes::Pattern->new('/');
-$pattern->defaults({action => 'index'});
-$result = $pattern->match('/test/foo/bar');
-is $result, undef, 'no result';
-$result = $pattern->match('/');
-is $result->{action}, 'index', 'right value';
-is $pattern->render, '/', 'right result';
-
-# Regex in pattern
-$pattern =
- MojoX::Routes::Pattern->new('/test/(controller)/:action/(id)', id => '\d+');
-$pattern->defaults({action => 'index', id => 1});
-$result = $pattern->match('/test/foo/bar/203');
-is $result->{controller}, 'foo', 'right value';
-is $result->{action}, 'bar', 'right value';
-is $result->{id}, 203, 'right value';
-$result = $pattern->match('/test/foo/bar/baz');
-is_deeply $result, undef, 'no result';
-is $pattern->render({controller => 'zzz', action => 'index', id => 13}),
- '/test/zzz/index/13', 'right result';
-is $pattern->render({controller => 'zzz'}), '/test/zzz', 'right result';
-
-# Quoted symbol
-$pattern = MojoX::Routes::Pattern->new('/(:controller)test/(action)');
-$pattern->defaults({action => 'index'});
-$result = $pattern->match('/footest/bar');
-is $result->{controller}, 'foo', 'right value';
-is $result->{action}, 'bar', 'right value';
-is $pattern->render({controller => 'zzz', action => 'lala'}), '/zzztest/lala',
- 'right result';
-$result = $pattern->match('/test/lala');
-is $result, undef, 'no result';
-
-# Format
-$pattern = MojoX::Routes::Pattern->new('/(controller)test/(action)');
-is $pattern->format, undef, 'no value';
-$pattern = MojoX::Routes::Pattern->new('/(:controller)test/:action.html');
-is $pattern->format, 'html', 'right value';
-$pattern = MojoX::Routes::Pattern->new('/index.cgi');
-is $pattern->format, 'cgi', 'right value';
-
-# Relaxed
-$pattern = MojoX::Routes::Pattern->new('/test/(.controller)/:action');
-$result = $pattern->match('/test/foo.bar/baz');
-is $result->{controller}, 'foo.bar', 'right value';
-is $result->{action}, 'baz', 'right value';
-is $pattern->render({controller => 'foo.bar', action => 'baz'}),
- '/test/foo.bar/baz', 'right result';
-$pattern = MojoX::Routes::Pattern->new('/test/(.groovy)');
-$result = $pattern->match('/test/foo.bar');
-is $pattern->format, undef, 'no value';
-is $result->{groovy}, 'foo.bar', 'right value';
-is $result->{format}, undef, 'no value';
-is $pattern->render({groovy => 'foo.bar'}), '/test/foo.bar', 'right result';
-
-# Wildcard
-$pattern = MojoX::Routes::Pattern->new('/test/(:controller)/(*action)');
-$result = $pattern->match('/test/foo/bar.baz/yada');
-is $result->{controller}, 'foo', 'right value';
-is $result->{action}, 'bar.baz/yada', 'right value';
-is $pattern->render({controller => 'foo', action => 'bar.baz/yada'}),
- '/test/foo/bar.baz/yada', 'right result';
-
-# Render false value
-$pattern = MojoX::Routes::Pattern->new('/:id');
-is $pattern->render({id => 0}), '/0', 'right result';
-
-# Regex in path
-$pattern = MojoX::Routes::Pattern->new('/:test');
-$result = $pattern->match('/test(test)(\Qtest\E)(');
-is $result->{test}, 'test(test)(\Qtest\E)(', 'right value';
-is $pattern->render({test => '23'}), '/23', 'right result';
@@ -1,47 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 5;
-
-use Mojo;
-use MojoX::Dispatcher::Routes::Controller;
-use MojoX::Renderer;
-
-# Actually, she wasn't really my girlfriend,
-# she just lived nextdoor and never closed her curtains.
-my $c = MojoX::Dispatcher::Routes::Controller->new(app => Mojo->new);
-$c->app->log->path(undef);
-$c->app->log->level('fatal');
-my $r = MojoX::Renderer->new(default_format => 'debug');
-$r->add_handler(
- debug => sub {
- my ($self, $c, $output) = @_;
- $$output .= 'Hello Mojo!';
- }
-);
-$c->stash->{format} = 'something';
-
-# Normal rendering
-$c->stash->{template} = 'something';
-$c->stash->{handler} = 'debug';
-is_deeply [$r->render($c)], ['Hello Mojo!', 'text/plain'], 'normal rendering';
-
-# Normal rendering with layout
-$c->stash->{template} = 'something';
-$c->stash->{layout} = 'something';
-$c->stash->{handler} = 'debug';
-is_deeply [$r->render($c)], ['Hello Mojo!Hello Mojo!', 'text/plain'],
- 'normal rendering with layout';
-is delete $c->stash->{layout}, 'something';
-
-# Rendering a path with dots
-$c->stash->{template} = 'some.path.with.dots/template';
-$c->stash->{handler} = 'debug';
-is_deeply [$r->render($c)], ['Hello Mojo!', 'text/plain'],
- 'rendering a path with dots';
-
-# Unrecognized handler
-$c->stash->{handler} = 'not_defined';
-is $r->render($c), undef, 'return undef for unrecognized handler';
@@ -1,515 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 205;
-
-use Mojo::Transaction::HTTP;
-
-# They're not very heavy, but you don't hear me not complaining.
-use_ok 'MojoX::Routes';
-use_ok 'MojoX::Routes::Match';
-
-# Routes
-my $r = MojoX::Routes->new;
-
-# /clean
-$r->route('/clean')->to(clean => 1);
-
-# /clean/too
-$r->route('/clean/too')->to(something => 1);
-
-# /*/test
-my $test = $r->route('/:controller/test')->to(action => 'test');
-
-# /*/test/edit
-$test->route('/edit')->to(action => 'edit')->name('test_edit');
-
-# /*/test/delete/*
-$test->route('/delete/(id)', id => qr/\d+/)->to(action => 'delete', id => 23);
-
-# /test2
-my $test2 = $r->bridge('/test2')->to(controller => 'test2');
-
-# /test2 (inline)
-my $test4 = $test2->bridge->to(controller => 'index');
-
-# /test2/foo
-$test4->route('/foo')->to(controller => 'baz');
-
-# /test2/bar
-$test4->route('/bar')->to(controller => 'lalala');
-
-# /test2/baz
-$test2->route('/baz')->to('just#works');
-
-# /test3
-my $test3 = $r->waypoint('/test3')->to(controller => 's', action => 'l');
-
-# /test3/edit
-$test3->route('/edit')->to(action => 'edit');
-
-# /
-$r->route('/')->to(controller => 'hello', action => 'world');
-
-# /wildcards/1/*
-$r->route('/wildcards/1/(*wildcard)', wildcard => qr/(.*)/)
- ->to(controller => 'wild', action => 'card');
-
-# /wildcards/2/*
-$r->route('/wildcards/2/(*wildcard)')
- ->to(controller => 'card', action => 'wild');
-
-# /wildcards/3/*/foo
-$r->route('/wildcards/3/(*wildcard)/foo')
- ->to(controller => 'very', action => 'dangerous');
-
-# /format
-# /format.html
-$r->route('/format')
- ->to(controller => 'hello', action => 'you', format => 'html');
-
-# /format2.html
-$r->route('/format2.html')->to(controller => 'you', action => 'hello');
-
-# /format2.json
-$r->route('/format2.json')->to(controller => 'you', action => 'hello_json');
-
-# /format3/*.html
-$r->route('/format3/:foo.html')->to(controller => 'me', action => 'bye');
-
-# /format3/*.json
-$r->route('/format3/:foo.json')->to(controller => 'me', action => 'bye_json');
-
-# /articles
-# /articles.html
-# /articles/1
-# /articles/1.html
-# /articles/1/edit
-# /articles/1/delete
-my $articles = $r->waypoint('/articles')->to(
- controller => 'articles',
- action => 'index',
- format => 'html'
-);
-my $wp = $articles->waypoint('/:id')->to(
- controller => 'articles',
- action => 'load',
- format => 'html'
-);
-my $bridge = $wp->bridge->to(
- controller => 'articles',
- action => 'load',
- format => 'html'
-);
-$bridge->route('/edit')->to(controller => 'articles', action => 'edit');
-$bridge->route('/delete')->to(
- controller => 'articles',
- action => 'delete',
- format => undef
-)->name('articles_delete');
-
-# GET /method/get
-$r->route('/method/get')->via('GET')
- ->to(controller => 'method', action => 'get');
-
-# POST /method/post
-$r->route('/method/post')->via('post')
- ->to(controller => 'method', action => 'post');
-
-# POST|GET /method/post_get
-$r->route('/method/post_get')->via(qw/POST get/)
- ->to(controller => 'method', action => 'post_get');
-
-# /simple/form
-$r->route('/simple/form')->to('test-test#test');
-
-# /edge/gift
-my $edge = $r->route('/edge');
-my $auth = $edge->bridge('/auth')->to('auth#check');
-$auth->route('/about/')->to('pref#about');
-$auth->bridge->to('album#allow')->route('/album/create/')->to('album#create');
-$auth->route('/gift/')->to('gift#index')->name('gift');
-
-# Make sure stash stays clean
-my $tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/clean');
-my $m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{clean}, 1, 'right value';
-is $m->stack->[0]->{something}, undef, 'no value';
-is $m->url_for, '/clean', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/clean/too');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{clean}, undef, 'no value';
-is $m->stack->[0]->{something}, 1, 'right value';
-is $m->url_for, '/clean/too', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Real world example using most features at once
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'articles', 'right value';
-is $m->stack->[0]->{action}, 'index', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->url_for, '/articles', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles/1.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'articles', 'right value';
-is $m->stack->[0]->{action}, 'load', 'right value';
-is $m->stack->[0]->{id}, '1', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->url_for(format => 'html'), '/articles/1.html', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles/1/edit');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[1]->{controller}, 'articles', 'right value';
-is $m->stack->[1]->{action}, 'edit', 'right value';
-is $m->stack->[1]->{format}, 'html', 'right value';
-is $m->url_for, '/articles/1/edit', 'right URL';
-is $m->url_for(format => 'html'), '/articles/1/edit.html', 'right URL';
-is $m->url_for('articles_delete', format => undef), '/articles/delete',
- 'right URL';
-is $m->url_for('articles_delete'), '/articles/delete', 'right URL';
-is $m->url_for('articles_delete', id => 12), '/articles/12/delete',
- 'right URL';
-is @{$m->stack}, 2, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles/1/delete');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[1]->{controller}, 'articles', 'right value';
-is $m->stack->[1]->{action}, 'delete', 'right value';
-is $m->stack->[1]->{format}, undef, 'no value';
-is $m->url_for, '/articles/1/delete', 'right URL';
-is @{$m->stack}, 2, 'right number of elements';
-
-# Root
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->captures->{controller}, 'hello', 'right value';
-is $m->captures->{action}, 'world', 'right value';
-is $m->stack->[0]->{controller}, 'hello', 'right value';
-is $m->stack->[0]->{action}, 'world', 'right value';
-is $m->url_for, '/', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Path and captures
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/foo/test/edit');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->captures->{controller}, 'foo', 'right value';
-is $m->captures->{action}, 'edit', 'right value';
-is $m->stack->[0]->{controller}, 'foo', 'right value';
-is $m->stack->[0]->{action}, 'edit', 'right value';
-is $m->url_for, '/foo/test/edit', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Optional captures in sub route with requirement
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/bar/test/delete/22');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->captures->{controller}, 'bar', 'right value';
-is $m->captures->{action}, 'delete', 'right value';
-is $m->captures->{id}, 22, 'right value';
-is $m->stack->[0]->{controller}, 'bar', 'right value';
-is $m->stack->[0]->{action}, 'delete', 'right value';
-is $m->stack->[0]->{id}, 22, 'right value';
-is $m->url_for, '/bar/test/delete/22', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Defaults in sub route
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/bar/test/delete');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->captures->{controller}, 'bar', 'right value';
-is $m->captures->{action}, 'delete', 'right value';
-is $m->captures->{id}, 23, 'right value';
-is $m->stack->[0]->{controller}, 'bar', 'right value';
-is $m->stack->[0]->{action}, 'delete', 'right value';
-is $m->stack->[0]->{id}, 23, 'right value';
-is $m->url_for, '/bar/test/delete', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Chained routes
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test2/foo');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'test2', 'right value';
-is $m->stack->[1]->{controller}, 'index', 'right value';
-is $m->stack->[2]->{controller}, 'baz', 'right value';
-is $m->captures->{controller}, 'baz', 'right value';
-is $m->url_for, '/test2/foo', 'right URL';
-is @{$m->stack}, 3, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test2/bar');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'test2', 'right value';
-is $m->stack->[1]->{controller}, 'index', 'right value';
-is $m->stack->[2]->{controller}, 'lalala', 'right value';
-is $m->captures->{controller}, 'lalala', 'right value';
-is $m->url_for, '/test2/bar', 'right URL';
-is @{$m->stack}, 3, 'right number of elements';
-$tx->req->url->parse('/test2/baz');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'test2', 'right value';
-is $m->stack->[1]->{controller}, 'just', 'right value';
-is $m->stack->[1]->{action}, 'works', 'right value';
-is $m->stack->[2], undef, 'no value';
-is $m->captures->{controller}, 'just', 'right value';
-is $m->url_for, '/test2/baz', 'right URL';
-is @{$m->stack}, 2, 'right number of elements';
-
-# Waypoints
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 's', 'right value';
-is $m->stack->[0]->{action}, 'l', 'right value';
-is $m->url_for, '/test3', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3/');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 's', 'right value';
-is $m->stack->[0]->{action}, 'l', 'right value';
-is $m->url_for, '/test3', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3/edit');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 's', 'right value';
-is $m->stack->[0]->{action}, 'edit', 'right value';
-is $m->url_for, '/test3/edit', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Named url_for
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->url_for, '/test3', 'right URL';
-is $m->url_for('test_edit', controller => 'foo'), '/foo/test/edit',
- 'right URL';
-is $m->url_for('test_edit', {controller => 'foo'}), '/foo/test/edit',
- 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Wildcards
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/1/hello/there');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'wild', 'right value';
-is $m->stack->[0]->{action}, 'card', 'right value';
-is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
-is $m->url_for, '/wildcards/1/hello/there', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/2/hello/there');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'card', 'right value';
-is $m->stack->[0]->{action}, 'wild', 'right value';
-is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
-is $m->url_for, '/wildcards/2/hello/there', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/3/hello/there/foo');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'very', 'right value';
-is $m->stack->[0]->{action}, 'dangerous', 'right value';
-is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
-is $m->url_for, '/wildcards/3/hello/there/foo', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Escaped
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/1/http://www.google.com');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'wild', 'right value';
-is $m->stack->[0]->{action}, 'card', 'right value';
-is $m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value';
-is $m->url_for, '/wildcards/1/http://www.google.com', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/1/http%3A%2F%2Fwww.google.com');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'wild', 'right value';
-is $m->stack->[0]->{action}, 'card', 'right value';
-is $m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value';
-is $m->url_for, '/wildcards/1/http://www.google.com', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Format
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'hello', 'right value';
-is $m->stack->[0]->{action}, 'you', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->url_for, '/format', 'right URL';
-is $m->url_for(format => undef), '/format', 'right URL';
-is $m->url_for(format => 'html'), '/format.html', 'right URL';
-is $m->url_for(format => 'txt'), '/format.txt', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'hello', 'right value';
-is $m->stack->[0]->{action}, 'you', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->url_for, '/format', 'right URL';
-is $m->url_for(format => undef), '/format', 'right URL';
-is $m->url_for(format => 'html'), '/format.html', 'right URL';
-is $m->url_for(format => 'txt'), '/format.txt', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format2.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'you', 'right value';
-is $m->stack->[0]->{action}, 'hello', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->url_for, '/format2.html', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format2.json');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'you', 'right value';
-is $m->stack->[0]->{action}, 'hello_json', 'right value';
-is $m->stack->[0]->{format}, 'json', 'right value';
-is $m->url_for, '/format2.json', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format3/baz.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'me', 'right value';
-is $m->stack->[0]->{action}, 'bye', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->stack->[0]->{foo}, 'baz', 'right value';
-is $m->url_for, '/format3/baz.html', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format3/baz.json');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'me', 'right value';
-is $m->stack->[0]->{action}, 'bye_json', 'right value';
-is $m->stack->[0]->{format}, 'json', 'right value';
-is $m->stack->[0]->{foo}, 'baz', 'right value';
-is $m->url_for, '/format3/baz.json', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Request methods
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/method/get.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'method', 'right value';
-is $m->stack->[0]->{action}, 'get', 'right value';
-is $m->stack->[0]->{format}, 'html', 'right value';
-is $m->url_for, '/method/get', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('POST');
-$tx->req->url->parse('/method/post');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'method', 'right value';
-is $m->stack->[0]->{action}, 'post', 'right value';
-is $m->stack->[0]->{format}, undef, 'no value';
-is $m->url_for, '/method/post', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/method/post_get');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'method', 'right value';
-is $m->stack->[0]->{action}, 'post_get', 'right value';
-is $m->stack->[0]->{format}, undef, 'no value';
-is $m->url_for, '/method/post_get', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('POST');
-$tx->req->url->parse('/method/post_get');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'method', 'right value';
-is $m->stack->[0]->{action}, 'post_get', 'right value';
-is $m->stack->[0]->{format}, undef, 'no value';
-is $m->url_for, '/method/post_get', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('DELETE');
-$tx->req->url->parse('/method/post_get');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, undef, 'no value';
-is $m->stack->[0]->{action}, undef, 'no value';
-is $m->stack->[0]->{format}, undef, 'no value';
-is $m->url_for, '', 'no URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Not found
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/not_found');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->url_for('test_edit', controller => 'foo'), '/foo/test/edit',
- 'right URL';
-is @{$m->stack}, 0, 'no elements';
-
-# Simplified form
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/simple/form');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'test-test', 'right value';
-is $m->stack->[0]->{action}, 'test', 'right value';
-is $m->stack->[0]->{format}, undef, 'no value';
-is $m->url_for, '/simple/form', 'right URL';
-is $m->url_for('current'), '/simple/form', 'right URL';
-is @{$m->stack}, 1, 'right number of elements';
-
-# Special edge case with nested bridges
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/edge/auth/gift');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is $m->stack->[0]->{controller}, 'auth', 'right value';
-is $m->stack->[0]->{action}, 'check', 'right value';
-is $m->stack->[0]->{format}, undef, 'no value';
-is $m->stack->[1]->{controller}, 'gift', 'right value';
-is $m->stack->[1]->{action}, 'index', 'right value';
-is $m->stack->[1]->{format}, undef, 'no value';
-is $m->stack->[2], undef, 'no value';
-is $m->url_for, '/edge/auth/gift', 'right URL';
-is $m->url_for('gift'), '/edge/auth/gift', 'right URL';
-is $m->url_for('current'), '/edge/auth/gift', 'right URL';
-is @{$m->stack}, 2, 'right number of elements';
@@ -14,9 +14,8 @@ plan skip_all => 'set TEST_POD to enable this test (developer only!)'
my @client = qw/max_keep_alive_connections process/;
my @ioloop = qw/error_cb hup_cb idle_cb lock_cb read_cb tick_cb unlock_cb/;
my @message = qw/finish_cb progress_cb/;
-my @server =
- qw/build_tx_cb handler_cb max_keep_alive_requests websocket_handshake_cb/;
-my @tx = qw/finished helper receive_message resume_cb upgrade_cb/;
+my @server = qw/build_tx_cb handler_cb max_keep_alive_requests/;
+my @tx = qw/finished helper receive_message resume_cb upgrade_cb/;
# Marge, I'm going to miss you so much. And it's not just the sex.
# It's also the food preparation.